From 29d0acf6f652247b092f63ad8d393b09e1d9ddd7 Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Fri, 6 Nov 2026 19:07:49 +0000 Subject: [PATCH 1/7] Split BusyBeaver/Defs.lean into modular submodules with umbrella re-export --- BusyBeaver/Defs.lean | 715 ++------------------------------ BusyBeaver/Defs/Core.lean | 153 +++++++ BusyBeaver/Defs/Odometer.lean | 130 ++++++ BusyBeaver/Defs/Patterns.lean | 134 ++++++ BusyBeaver/Defs/Stack.lean | 257 ++++++++++++ BusyBeaver/Defs/Transducer.lean | 174 ++++++++ BusyBeaverChallenge.lean | 15 + 7 files changed, 887 insertions(+), 691 deletions(-) create mode 100644 BusyBeaver/Defs/Core.lean create mode 100644 BusyBeaver/Defs/Odometer.lean create mode 100644 BusyBeaver/Defs/Patterns.lean create mode 100644 BusyBeaver/Defs/Stack.lean create mode 100644 BusyBeaver/Defs/Transducer.lean diff --git a/BusyBeaver/Defs.lean b/BusyBeaver/Defs.lean index 5715fed2..49ade9c8 100644 --- a/BusyBeaver/Defs.lean +++ b/BusyBeaver/Defs.lean @@ -4,699 +4,32 @@ Released under Apache 2.0 license as described in the file LICENSE. -/ module -public import Mathlib.Computability.TuringMachine.PostTuringMachine -public import Mathlib.Data.List.Basic -public import Mathlib.Data.Nat.Basic +public import BusyBeaver.Defs.Core +public import BusyBeaver.Defs.Patterns +public import BusyBeaver.Defs.Stack +public import BusyBeaver.Defs.Odometer +public import BusyBeaver.Defs.Transducer /-! # Busy Beaver Holdout Definitions (`BusyBeaver.Defs`) -Canonical Post-Turing machine execution model and behavioral goal predicates for Busy Beaver -holdouts: - -- `IsHalt` — `M` eventually reaches a halting configuration from the blank tape (`init []`). -- `IsNotHalt` (`IsDoesNotHalt`) — `M` never halts from the blank tape. -- `HasCollatzReduction` — `M` is governed by a closed accelerated regular-expression tape pattern - set. -- `HasStackedCollatzReduction` — `M` is governed by a closed accelerated stack-word tape pattern - set. -- `HasStackReduction` — `M` is governed by a closed 2nd-order digit-stack system. -- `HasOdometerReduction` — `M` is governed by a closed mixed-radix odometer-word hub. -- `HasTransducerReduction` — `M` is governed by a closed bidirectional word-stack transducer. +Umbrella module re-exporting the canonical Post-Turing machine execution model and behavioral +goal predicates for Busy Beaver holdouts. + +## Goal Predicates by Defining Module + +- `BusyBeaver.Defs.Core`: + - `IsHalt` — `M` eventually reaches a halting configuration from the blank tape (`init []`). + - `IsNotHalt` (`IsDoesNotHalt`) — `M` never halts from the blank tape. +- `BusyBeaver.Defs.Patterns`: + - `HasCollatzReduction` — `M` is governed by a closed accelerated regular-expression tape + pattern set. +- `BusyBeaver.Defs.Stack`: + - `HasStackedCollatzReduction` — `M` is governed by a closed accelerated stack-word tape + pattern set. + - `HasStackReduction` — `M` is governed by a closed 2nd-order digit-stack system. +- `BusyBeaver.Defs.Odometer`: + - `HasOdometerReduction` — `M` is governed by a closed mixed-radix odometer-word hub. +- `BusyBeaver.Defs.Transducer`: + - `HasTransducerReduction` — `M` is governed by a closed bidirectional word-stack transducer. -/ - -@[expose] public section - -namespace BusyBeaver - -open Relation Turing - -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] - -/-- A Turing machine statement writing `symbol` and moving the tape head in direction `dir`. -/ -structure Stmt (Γ : Type*) where - /-- Construct a write-and-move statement. -/ - write :: - /-- Symbol written to the tape cell under the head. -/ - symbol : Γ - /-- Direction in which the tape head moves after writing. -/ - dir : Dir - deriving Inhabited - -/-- A Post-Turing machine with symbol type `Γ` and state label type `Λ`. -/ -@[nolint unusedArguments] -def Machine (Γ Λ : Type*) [Inhabited Λ] := - Λ → Γ → Option (Option Λ × Stmt Γ) - -omit [Inhabited Γ] in -instance Machine.inhabited : Inhabited (Machine Γ Λ) := by - unfold Machine; infer_instance - -/-- Instantaneous configuration of a Turing machine: optional control state `q` and `tape`. -/ -@[ext] -structure Cfg (Γ Λ : Type*) [Inhabited Γ] where - /-- Current control state (`none` represents an explicit terminal state). -/ - q : Option Λ - /-- Current doubly-infinite tape centered at the head. -/ - tape : Tape Γ - -instance Cfg.inhabited : Inhabited (Cfg Γ Λ) := ⟨⟨default, default⟩⟩ - -/-- Configuration in state `q` with the tape head reading the first symbol of `r`. -/ -@[reducible] def Cfg.headRight {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := - ⟨some q, ⟨r.head, l, r.tail⟩⟩ - -/-- Configuration in state `q` with the tape head reading the first symbol of `l`. -/ -@[reducible] def Cfg.headLeft {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := - ⟨some q, ⟨l.head, l.tail, r⟩⟩ - -/-- Single-step execution semantics of a `BusyBeaver.Machine`. -/ -def step (M : Machine Γ Λ) : Cfg Γ Λ → Option (Cfg Γ Λ) - | ⟨none, _⟩ => none - | ⟨some q, T⟩ => - (M q T.1).map fun ⟨q', a⟩ ↦ - ⟨q', match a with | Stmt.write a d => (T.write a).move d⟩ - -/-- Initial configuration on tape prefix `l` (all-blank tape when `l = []`). -/ -def init (l : List Γ) : Cfg Γ Λ := ⟨some default, Tape.mk₁ l⟩ - -/-- Multi-step execution semantics (`n` steps). -/ -def multiStep (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : ℕ) : Option (Cfg Γ Λ) := - (Option.bind · (step M))^[n] config - -/-- Exact `n`-step reachability (`multiStep M c₁ n = some c₂`). -/ -def ReachesIn (M : Machine Γ Λ) (n : ℕ) (c₁ c₂ : Cfg Γ Λ) : Prop := - multiStep M c₁ n = some c₂ - -/-- Reflexive-transitive multi-step reachability (`∃ n, multiStep M c₁ n = some c₂`). -/ -def ReachesStar (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := - ∃ n, multiStep M c₁ n = some c₂ - -/-- Non-empty transitive multi-step reachability (`∃ n > 0, multiStep M c₁ n = some c₂`). -/ -def ReachesPlus (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := - ∃ n > 0, multiStep M c₁ n = some c₂ - -scoped notation3 c₁ " [" M "]⊢ " c₂ => step M c₁ = some c₂ -scoped notation3 c₁ " [" M "]⊢^{" n "} " c₂ => multiStep M c₁ n = some c₂ -scoped notation3 c₁ " [" M "]⊢* " c₂ => ReachesStar M c₁ c₂ -scoped notation3 c₁ " [" M "]⊢⁺ " c₂ => ReachesPlus M c₁ c₂ - -scoped notation l " {{" s "}} " r => (⟨s, l, r⟩ : Tape _) -scoped notation:67 s:67 " << " a:68 => ListBlank.cons a s -scoped infixr:67 " >> " => ListBlank.cons -scoped notation:67 s:67 " <+ " l:68 => ListBlank.append l s -scoped infixr:67 " +> " => ListBlank.append -scoped notation3 l " {{" q "}}> " r => (⟨some q, ⟨ListBlank.head r, l, ListBlank.tail r⟩⟩ : Cfg _ _) -scoped notation3 l " <{{" q "}} " r => (⟨some q, ⟨ListBlank.head l, ListBlank.tail l, r⟩⟩ : Cfg _ _) - - -/-- Repeat finite list `l` `n` times (`l ^ n`). -/ -instance instHPowListNat : HPow (List Γ) ℕ (List Γ) := - ⟨fun l n => (List.replicate n l).flatten⟩ - -/-- A configuration is halting for `M` if no next transition is defined. -/ -def IsHaltingConfiguration (M : Machine Γ Λ) (cfg : Cfg Γ Λ) : Prop := - (step M cfg).isNone - -/-- `M` eventually reaches a halting configuration when started on the blank tape (`init []`). -/ -def IsHalt (M : Machine Γ Λ) : Prop := - ∃ cfg : Cfg Γ Λ, ReachesStar M (init []) cfg ∧ (step M cfg).isNone - -/-- `M` never halts when started on the blank tape (`init []`). -/ -def IsNotHalt (M : Machine Γ Λ) : Prop := - ∀ cfg : Cfg Γ Λ, ReachesStar M (init []) cfg → (step M cfg).isSome - -/-- Alias for `IsNotHalt`. -/ -abbrev IsDoesNotHalt (M : Machine Γ Λ) : Prop := IsNotHalt M - -/-- Parametric regular-expression half-tape expressions for `HasCollatzReduction`. -/ -inductive TapeExpr (Γ : Type*) where - /-- All-blank tail (`default : ListBlank Γ`). -/ - | default : TapeExpr Γ - /-- Single symbol `a` followed by `rest`. -/ - | sym (a : Γ) (rest : TapeExpr Γ) - /-- Finite block `blk` repeated `vars var_idx` times followed by `rest`. -/ - | rep (blk : List Γ) (var_idx : ℕ) (rest : TapeExpr Γ) - -/-- Evaluate a `TapeExpr Γ` under variable assignment `vars : ℕ → ℕ`. -/ -def evalTapeExpr {Γ : Type*} [Inhabited Γ] : TapeExpr Γ → (ℕ → ℕ) → ListBlank Γ - | .default, _ => default - | .sym a rest, vars => ListBlank.cons a (evalTapeExpr rest vars) - | .rep blk v rest, vars => ListBlank.append (blk ^ vars v) (evalTapeExpr rest vars) - -/-- Parametric full-tape configuration pattern. -/ -structure TapePattern (Γ Λ : Type*) where - /-- Left half-tape expression. -/ - left : TapeExpr Γ - /-- Control state (`some q` or `none`). -/ - head : Option Λ - /-- Right half-tape expression (whose head is under the tape head). -/ - right : TapeExpr Γ - -/-- Evaluate a `TapePattern Γ Λ` under variable assignment `vars : ℕ → ℕ`. -/ -def evalTapePattern {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] - (p : TapePattern Γ Λ) (vars : ℕ → ℕ) : Cfg Γ Λ := - let r := evalTapeExpr p.right vars - ⟨p.head, ⟨r.head, evalTapeExpr p.left vars, r.tail⟩⟩ - -/-- Guard condition over `ℕ`-valued pattern variables. -/ -inductive VarCond where - /-- `vars idx ≥ val`. -/ - | ge_const (idx : ℕ) (val : ℕ) - /-- `vars idx1 ≥ vars idx2`. -/ - | ge_var (idx1 idx2 : ℕ) - /-- Conjunction of conditions. -/ - | and (c1 c2 : VarCond) - /-- Disjunction of conditions. -/ - | or (c1 c2 : VarCond) - /-- Negation of a condition. -/ - | not (c : VarCond) - /-- Trivially satisfied condition. -/ - | true - -/-- Evaluate a `VarCond` under variable assignment `vars : ℕ → ℕ`. -/ -def evalVarCond : VarCond → (ℕ → ℕ) → Prop - | .ge_const idx val, vars => vars idx ≥ val - | .ge_var idx1 idx2, vars => vars idx1 ≥ vars idx2 - | .and c1 c2, vars => evalVarCond c1 vars ∧ evalVarCond c2 vars - | .or c1 c2, vars => evalVarCond c1 vars ∨ evalVarCond c2 vars - | .not c, vars => ¬ evalVarCond c vars - | .true, _ => True - -/-- Finite list of guarded tape patterns. -/ -abbrev TapePatternSet (Γ Λ : Type*) := List (TapePattern Γ Λ × VarCond) - -/-- Membership of configuration `cfg` in a `TapePatternSet`. -/ -def IsInPatternSet {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] - (ps : TapePatternSet Γ Λ) (cfg : Cfg Γ Λ) : Prop := - ∃ entry : TapePattern Γ Λ × VarCond, entry ∈ ps ∧ - ∃ vars : ℕ → ℕ, cfg = evalTapePattern entry.1 vars ∧ evalVarCond entry.2 vars - -/-- `ps` is a closed accelerated `TapePatternSet` for `M` if `M`'s blank-tape trajectory enters -`ps` and every member configuration of `ps` steps in `ReachesPlus` (`n > 0` steps) either to -another member of `ps` or to a halting configuration. -/ -def IsClosedPatternSet (M : Machine Γ Λ) (ps : TapePatternSet Γ Λ) : Prop := - (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInPatternSet ps cfg₀) ∧ - (∀ cfg, IsInPatternSet ps cfg → - ∃ cfg', ReachesPlus M cfg cfg' ∧ - (IsInPatternSet ps cfg' ∨ (step M cfg').isNone)) - -/-- `M`'s blank-tape trajectory enters a closed accelerated `TapePatternSet` in which every -member configuration steps in `ReachesPlus` either to another member or to a halting state. -/ -def HasCollatzReduction (M : Machine Γ Λ) : Prop := - ∃ ps : TapePatternSet Γ Λ, IsClosedPatternSet M ps - -/-- An abstract partial transition system `next : S → Option S` halts from `s₀ : S` if iterating -`next` from `some s₀` eventually produces `none`. -/ -def CollatzHalts {S : Type*} (next : S → Option S) (s₀ : S) : Prop := - ∃ n : ℕ, ((Option.bind · next)^[n] (some s₀)).isNone - -/-- `encode`, `next`, and `start` form a valid Collatz-like acceleration of `M` when: -1. `M` reaches `encode start` from the blank tape (`init []`), -2. Every defined step `next s = some s'` takes `M` from `encode s` to `encode s'` in `ReachesPlus` - (at least one raw Turing machine step), and -3. Every undefined step `next s = none` means `M` reaches a halting configuration from - `encode s`. -/ -structure IsValidAcceleration (M : Machine Γ Λ) {S : Type*} - (start : S) (encode : S → Cfg Γ Λ) (next : S → Option S) : Prop where - /-- `M` reaches `encode start` from the blank tape (`init []`). -/ - init_reaches : ReachesStar M (init []) (encode start) - /-- Every non-halting accelerated step takes at least one Turing machine step. -/ - step_some : ∀ s s', next s = some s' → ReachesPlus M (encode s) (encode s') - /-- Every halting accelerated state reaches a halting Turing machine configuration. -/ - step_none : ∀ s, next s = none → - ∃ cfg', ReachesStar M (encode s) cfg' ∧ (step M cfg').isNone - -/-- Parametric half-tape segment for `HasStackedCollatzReduction`: in addition to single symbols -and repeated blocks, a `.word words stack_idx` segment expands a variable-length stack word -`stacks stack_idx : List ℕ` over a finite block vocabulary `words : List (List Γ)`. -/ -inductive StackSeg (Γ : Type*) where - /-- Single symbol `a`. -/ - | sym (a : Γ) - /-- Finite block `blk` repeated `vars var_idx` times. -/ - | rep (blk : List Γ) (var_idx : ℕ) - /-- Stack word `stacks stack_idx` expanded over block vocabulary `words`. -/ - | word (words : List (List Γ)) (stack_idx : ℕ) - -/-- Whether a `StackSeg Γ` is a `.word` stack segment. -/ -def StackSeg.isWord {Γ : Type*} : StackSeg Γ → Bool - | .word _ _ => true - | _ => false - -/-- A `StackSeg Γ` is well-formed when every repeated block or stack-vocabulary block is non-empty -and contains no blank (`default`) symbols, and every `.word` vocabulary is non-empty. -/ -def StackSeg.WellFormed {Γ : Type*} [Inhabited Γ] [DecidableEq Γ] : StackSeg Γ → Bool - | .sym _ => true - | .rep blk _ => !blk.isEmpty && blk.all (· != default) - | .word words _ => !words.isEmpty && words.all (fun w => !w.isEmpty && w.all (· != default)) - -/-- Parametric stack-word half-tape expression (evaluated from head to blank tail). -/ -abbrev StackExpr (Γ : Type*) := List (StackSeg Γ) - -/-- Evaluate a single `StackSeg Γ` under counter assignment `vars : ℕ → ℕ` and stack assignment -`stks : ℕ → List ℕ`. -/ -def evalStackSeg {Γ : Type*} : StackSeg Γ → (ℕ → ℕ) → (ℕ → List ℕ) → List Γ - | .sym a, _, _ => [a] - | .rep blk v, vars, _ => blk ^ vars v - | .word words s, _, stks => ((stks s).map (fun d => words.getD d [])).flatten - -/-- Evaluate a `StackExpr Γ` under counter assignment `vars : ℕ → ℕ` and stack assignment -`stks : ℕ → List ℕ`. -/ -def evalStackExpr {Γ : Type*} [Inhabited Γ] : - StackExpr Γ → (ℕ → ℕ) → (ℕ → List ℕ) → ListBlank Γ - | [], _, _ => default - | seg :: rest, vars, stks => - ListBlank.append (evalStackSeg seg vars stks) (evalStackExpr rest vars stks) - -/-- Parametric stack-word full-tape configuration pattern. -/ -structure StackPattern (Γ Λ : Type*) where - /-- Left half-tape expression. -/ - left : StackExpr Γ - /-- Control state (`some q` or `none`). -/ - head : Option Λ - /-- Right half-tape expression (whose head is under the tape head). -/ - right : StackExpr Γ - -/-- A `StackPattern Γ Λ` is well-formed when all segments on both half-tapes are well-formed -(non-empty and blank-free blocks), at least one half-tape is empty (single-sided tape boundary), -and at most one `.word` stack segment appears across the pattern. -/ -def StackPattern.WellFormed {Γ Λ : Type*} [Inhabited Γ] [DecidableEq Γ] - (p : StackPattern Γ Λ) : Bool := - p.left.all StackSeg.WellFormed && - p.right.all StackSeg.WellFormed && - (p.left.isEmpty || p.right.isEmpty) && - (decide (p.left.countP StackSeg.isWord + p.right.countP StackSeg.isWord ≤ 1)) - -/-- Evaluate a `StackPattern Γ Λ` under counter assignment `vars : ℕ → ℕ` and stack assignment -`stks : ℕ → List ℕ`. -/ -def evalStackPattern {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] - (p : StackPattern Γ Λ) (vars : ℕ → ℕ) (stks : ℕ → List ℕ) : Cfg Γ Λ := - let r := evalStackExpr p.right vars stks - ⟨p.head, ⟨r.head, evalStackExpr p.left vars stks, r.tail⟩⟩ - -/-- Finite list of guarded stack-word tape patterns. -/ -abbrev StackPatternSet (Γ Λ : Type*) := List (StackPattern Γ Λ × VarCond) - -/-- A `StackPatternSet Γ Λ` is well-formed when it is non-empty and every pattern in it is -well-formed (`StackPattern.WellFormed`). -/ -def IsWellFormedStackPatternSet {Γ Λ : Type*} [Inhabited Γ] [DecidableEq Γ] - (ps : StackPatternSet Γ Λ) : Prop := - (!ps.isEmpty && ps.all (fun entry => entry.1.WellFormed)) = true - -/-- Membership of configuration `cfg` in a `StackPatternSet`. -/ -def IsInStackPatternSet {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] - (ps : StackPatternSet Γ Λ) (cfg : Cfg Γ Λ) : Prop := - ∃ entry : StackPattern Γ Λ × VarCond, entry ∈ ps ∧ - ∃ (vars : ℕ → ℕ) (stks : ℕ → List ℕ), - cfg = evalStackPattern entry.1 vars stks ∧ evalVarCond entry.2 vars - -/-- `ps` is a closed accelerated `StackPatternSet` for `M` if `ps` is well-formed -(`IsWellFormedStackPatternSet`), `M`'s blank-tape trajectory enters `ps`, and every member -configuration of `ps` steps in `ReachesPlus` (`n > 0` steps) either to another member of `ps` or -to a halting configuration. - -In `BusyBeaverChallenge.lean`, `IsClosedStackPatternSet` pins an explicit `ps` and is always paired -with a concrete Level B finite-state transducer acceleration (`IsValidAcceleration`). -/ -def IsClosedStackPatternSet [DecidableEq Γ] (M : Machine Γ Λ) (ps : StackPatternSet Γ Λ) : Prop := - IsWellFormedStackPatternSet ps ∧ - (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInStackPatternSet ps cfg₀) ∧ - (∀ cfg, IsInStackPatternSet ps cfg → - ∃ cfg', ReachesPlus M cfg cfg' ∧ - (IsInStackPatternSet ps cfg' ∨ (step M cfg').isNone)) - -/-- `M`'s blank-tape trajectory enters a well-formed closed accelerated `StackPatternSet` in which -every member configuration steps in `ReachesPlus` either to another member or to a halting state. -This existential summary is always paired in `BusyBeaverChallenge.lean` with a concrete `ps` -(`IsClosedStackPatternSet M ps`) and an explicit Level B finite-state transducer acceleration -(`IsValidAcceleration M start encode next`). -/ -def HasStackedCollatzReduction [DecidableEq Γ] (M : Machine Γ Λ) : Prop := - ∃ ps : StackPatternSet Γ Λ, IsClosedStackPatternSet M ps - -/-- Allowed half-tape views in a separator mode: either a fixed prefix in front of the encoded -stack, or a fixed prefix in front of its `.tail`. -/ -inductive HalfTapeView (Γ : Type*) where - /-- Fixed prefix `pfx` directly in front of the encoded stack. -/ - | id (pfx : List Γ) - /-- Fixed prefix `pfx` in front of the `.tail` of the encoded stack. -/ - | tail (pfx : List Γ) - -/-- Apply a `HalfTapeView Γ` to an encoded half-tape `ListBlank Γ`. -/ -def applyView {Γ : Type*} [Inhabited Γ] : HalfTapeView Γ → ListBlank Γ → ListBlank Γ - | .id pfx, s => ListBlank.append pfx s - | .tail pfx, s => ListBlank.append pfx s.tail - -/-- Right-nested `n`-tuple of natural numbers indexed by the machine's symbol count `n` -(`ℕ × ℕ` for 2-symbol machines, `ℕ × ℕ × ℕ` for 3-symbol machines, etc.). -/ -@[reducible] def StackTuple (n : ℕ) : Type := - Nat.casesOn n Unit (fun m => Nat.rec ℕ (fun _ ih => ℕ × ih) m) - -/-- Primary coordinate of a `StackTuple n`. -/ -@[reducible, simp] def stackDigit {n : ℕ} : StackTuple n → ℕ := - Nat.casesOn (motive := fun n => StackTuple n → ℕ) n - (fun _ => 0) - (fun m => Nat.casesOn (motive := fun m => StackTuple (m + 1) → ℕ) m - (fun a => a) - (fun _ p => p.1)) - -/-- Separator run length for the `(n + 1)`-symbol tail of a `StackTuple (n + 2)`. -/ -@[reducible, simp] def stackSepLen {n : ℕ} (sep maxSep : ℕ) : StackTuple n → ℕ := - Nat.casesOn (motive := fun n => StackTuple n → ℕ) n - (fun _ => 0) - (fun m => Nat.casesOn (motive := fun m => StackTuple (m + 1) → ℕ) m - (fun b => sep + b % maxSep) - (fun k p => (sep + p.1 % maxSep) * stackDigit (n := k + 1) p.2)) - -/-- Valid `(dSym, sSym)` symbol polarity for a `(k + 2)`-symbol machine: for 2-symbol machines -(`k = 0`), `(dSym, sSym) ∈ {(1, 0), (0, 1)}`; for `(k + 3)`-symbol machines (`k ≥ 1`), any -distinct `dSym ≠ sSym`. -/ -@[reducible] def IsValidStackPolarity : {k : ℕ} → Fin (k + 2) → Fin (k + 2) → Prop - | 0, dSym, sSym => - (dSym = (1 : Fin 2) ∧ sSym = (0 : Fin 2)) ∨ (dSym = (0 : Fin 2) ∧ sSym = (1 : Fin 2)) - | _ + 1, dSym, sSym => dSym ≠ sSym - -/-- Every `StackMode` evaluates `(L, R)` as a fixed control state `q` and fixed bounded -`HalfTapeView`s `vL, vR` (`≤ 8`-symbol prefixes) of `encLeft L` and `encRight R` (either scanning -`0` between them or stepping onto the left or right view). -/ -def IsValidStackModes {Γ Λ StackMode α : Type*} [Inhabited Γ] [OfNat Γ 0] - (encLeft encRight : List α → ListBlank Γ) - (eval : StackMode → List α → List α → Cfg Γ Λ) : Prop := - ∀ m : StackMode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), - (HalfTapeView.casesOn vL List.length List.length) ≤ 8 ∧ - (HalfTapeView.casesOn vR List.length List.length) ≤ 8 ∧ - ((∀ L R, eval m L R = - ⟨some q, ⟨(0 : Γ), applyView vL (encLeft L), applyView vR (encRight R)⟩⟩) ∨ - (∀ L R, eval m L R = Cfg.headLeft q (applyView vL (encLeft L)) (applyView vR (encRight R))) ∨ - (∀ L R, eval m L R = Cfg.headRight q (applyView vL (encLeft L)) (applyView vR (encRight R)))) - -/-- The blank-tape trajectory of `M` enters a closed 2nd-order digit-stack configuration family -over `(k + 2)`-symbol tuple stacks `List (StackTuple (k + 2))` with valid symbol polarity, -parametric unary-block stack recurrences (`strideL, offsetL, sepL, strideR, offsetR, sepR > 0`, -`1 ≤ maxSepL, maxSepR ≤ 4`), head-`dSym` non-surjectivity, at most 6 bounded-prefix modes -(`IsValidStackModes`), blank-tape multi-digit stack reachability (`3 ≤ L_g.length + R_g.length` -with a positive digit), an arbitrary-depth stack-frame transfer transition, and closure under -`ReachesPlus` up to halting. -/ -def HasStackReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] - (M : Machine (Fin (k + 2)) Λ) : Prop := - ∃ (StackMode : Type) - (dSym sSym : Fin (k + 2)) - (encLeft encRight : List (StackTuple (k + 2)) → ListBlank (Fin (k + 2))) - (evalStackCfg : - StackMode → List (StackTuple (k + 2)) → List (StackTuple (k + 2)) → Cfg (Fin (k + 2)) Λ) - (IsInStackSystem : Cfg (Fin (k + 2)) Λ → Prop), - IsValidStackPolarity dSym sSym ∧ - encLeft [] = default ∧ - encRight [] = default ∧ - (∀ a b L, (encLeft ((a, b) :: L)).head = dSym) ∧ - (∀ d b R, (encRight ((d, b) :: R)).head = dSym) ∧ - (∃ t : ListBlank (Fin (k + 2)), - t.head = dSym ∧ ∀ L : List (StackTuple (k + 2)), encLeft L ≠ t) ∧ - (∃ t : ListBlank (Fin (k + 2)), - t.head = dSym ∧ ∀ R : List (StackTuple (k + 2)), encRight R ≠ t) ∧ - (∃ strideL offsetL sepL maxSepL strideR offsetR sepR maxSepR : ℕ, - strideL > 0 ∧ offsetL > 0 ∧ sepL > 0 ∧ 1 ≤ maxSepL ∧ maxSepL ≤ 4 ∧ - strideR > 0 ∧ offsetR > 0 ∧ sepR > 0 ∧ 1 ≤ maxSepR ∧ maxSepR ≤ 4 ∧ - (∀ a b L, encLeft ((a, b) :: L) = - ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideL * a + offsetL)) - (ListBlank.append - (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepL maxSepL b)) - (encLeft L))) ∧ - (∀ d b R, encRight ((d, b) :: R) = - ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideR * d + offsetR)) - (ListBlank.append - (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepR maxSepR b)) - (encRight R)))) ∧ - (∃ modes : List StackMode, modes.length ≤ 6 ∧ ∀ m : StackMode, m ∈ modes) ∧ - IsValidStackModes encLeft encRight evalStackCfg ∧ - (∀ cfg, IsInStackSystem cfg ↔ ∃ m L R, cfg = evalStackCfg m L R) ∧ - (∀ m L R, IsInStackSystem (evalStackCfg m L R)) ∧ - (∃ (m_g : StackMode) (L_g R_g : List (StackTuple (k + 2))), - ReachesPlus M (init []) (evalStackCfg m_g L_g R_g) ∧ - 3 ≤ L_g.length + R_g.length ∧ - (∃ x ∈ L_g ++ R_g, 1 ≤ x.1)) ∧ - ((∃ (m m' : StackMode) (x : StackTuple (k + 2)) - (g : StackTuple (k + 2) → StackTuple (k + 2)) - (f : List (StackTuple (k + 2)) → List (StackTuple (k + 2))), - (∀ s, s.length ≤ (f s).length) ∧ - ∀ z L R, - ReachesPlus M (evalStackCfg m (x :: z :: L) R) (evalStackCfg m' (g z :: L) (f R))) ∨ - (∃ (m m' : StackMode) (x : StackTuple (k + 2)) - (g : StackTuple (k + 2) → StackTuple (k + 2)) - (f : List (StackTuple (k + 2)) → List (StackTuple (k + 2))), - (∀ s, s.length ≤ (f s).length) ∧ - ∀ z L R, - ReachesPlus M (evalStackCfg m L (x :: z :: R)) (evalStackCfg m' (f L) (g z :: R)))) ∧ - (∀ cfg, IsInStackSystem cfg → - ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) - -/-- Tape orientation for a mixed-radix odometer-word system (`HasOdometerReduction`). -/ -inductive OdomSide where - /-- Odometer stack on the left half-tape and active word on the right half-tape. -/ - | leftOdom - /-- Odometer stack on the right half-tape and active word on the left half-tape. -/ - | rightOdom - -/-- Evaluate the outward-facing hub configuration (head at `q_R` facing the active word `w` across -fixed boundary prefix `pfx_R`). -/ -@[reducible, simp] -def evalOdomR {Γ Λ : Type*} [Inhabited Γ] - (side : OdomSide) (q_R : Λ) (pfx_R : List Γ) - (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := - match side with - | .leftOdom => Cfg.headRight q_R (ListBlank.append pfx_R encOdom) w - | .rightOdom => Cfg.headLeft q_R w (ListBlank.append pfx_R encOdom) - -/-- Evaluate the inward-facing odometer entry configuration (head at `q_L` facing the odometer -stack `encOdom` across fixed boundary prefix `pfx_L`). -/ -@[reducible, simp] -def evalOdomL {Γ Λ : Type*} [Inhabited Γ] - (side : OdomSide) (q_L : Λ) (pfx_L : List Γ) - (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := - match side with - | .leftOdom => Cfg.headLeft q_L encOdom (ListBlank.append pfx_L w) - | .rightOdom => Cfg.headRight q_L (ListBlank.append pfx_L w) encOdom - -/-- The blank-tape trajectory of `M` enters a closed outward-facing odometer-word hub coupled with -a non-surjective multi-bit mixed-radix odometer stack (`OdomTok`, `cap`, `dec`, `drain`) supporting -odd-doubling (`2c + 1`), even-doubling (`2c`), and base-`b` division (`c / b`, `b ≥ 2`) frames, -universal capacity decrement (`cap stk ≥ 1`) and full-stack drain (`cap stk = 0`), active `0`-bit -reflection, and push/reflect/halt closure under `ReachesPlus`. -/ -def HasOdometerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] - (M : Machine (Fin (k + 2)) Λ) : Prop := - ∃ (OdomTok : Type) - (side : OdomSide) - (q_R : List OdomTok → Λ) - (q_L : Λ) - (pfx_R pfx_L odomBase : List (Fin (k + 2))) - (odomWord : OdomTok → List (Fin (k + 2))) - (encOdom : List OdomTok → ListBlank (Fin (k + 2))) - (cap : List OdomTok → ℕ) - (dec : List OdomTok → List OdomTok) - (decPfx : List OdomTok → List (Fin (k + 2))) - (drain : List OdomTok → List (Fin (k + 2))) - (IsInOdomSystem : Cfg (Fin (k + 2)) Λ → Prop), - (∃ toks : List OdomTok, 2 ≤ toks.length ∧ toks.length ≤ 6 ∧ ∀ t : OdomTok, t ∈ toks) ∧ - odomBase ≠ [] ∧ - (∀ t : OdomTok, 2 ≤ (odomWord t).length) ∧ - encOdom [] = ListBlank.append odomBase default ∧ - (∀ t stk, encOdom (t :: stk) = ListBlank.append (odomWord t) (encOdom stk)) ∧ - (∃ t : ListBlank (Fin (k + 2)), ∀ stk : List OdomTok, encOdom stk ≠ t) ∧ - cap [] = 0 ∧ - (∃ (t_inc t_even t_div : OdomTok) (b : ℕ) (blk_inc blk_div : List (Fin (k + 2))), - 2 ≤ b ∧ 2 ≤ blk_inc.length ∧ 2 ≤ blk_div.length ∧ - (∀ stk, cap (t_inc :: stk) = 2 * cap stk + 1) ∧ - (∀ stk, cap (t_even :: stk) = 2 * cap stk) ∧ - (∀ stk, cap (t_div :: stk) = cap stk / b) ∧ - (∀ stk w, - ReachesPlus M - (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_inc w)) - (evalOdomR side (q_R (t_inc :: stk)) pfx_R (encOdom (t_inc :: stk)) w)) ∧ - (∀ stk w, - ReachesPlus M - (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_div w)) - (evalOdomR side (q_R (t_div :: stk)) pfx_R (encOdom (t_div :: stk)) w))) ∧ - (∀ stk, (dec stk).length = stk.length) ∧ - (∀ stk, cap stk ≥ 1 → cap (dec stk) = cap stk - 1) ∧ - (∀ stk w, cap stk ≥ 1 → - ReachesPlus M - (evalOdomL side q_L pfx_L (encOdom stk) w) - (evalOdomR side (q_R (dec stk)) pfx_R (encOdom (dec stk)) - (ListBlank.append (decPfx stk) w))) ∧ - (∀ stk, cap stk = 0 → drain stk ≠ []) ∧ - (∀ stk w, cap stk = 0 → - ReachesPlus M - (evalOdomL side q_L pfx_L (encOdom stk) w) - (evalOdomR side (q_R []) pfx_R (encOdom []) (ListBlank.append (drain stk) w))) ∧ - (∀ stk w, - ReachesPlus M - (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.cons (0 : Fin (k + 2)) w)) - (evalOdomL side q_L pfx_L (encOdom stk) (ListBlank.cons (1 : Fin (k + 2)) w))) ∧ - (∀ stk w, - (∃ t w', - ReachesPlus M - (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) - (evalOdomR side (q_R (t :: stk)) pfx_R (encOdom (t :: stk)) w')) ∨ - (∃ w', - ReachesPlus M - (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) - (evalOdomL side q_L pfx_L (encOdom stk) w')) ∨ - (∃ cfg', - ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ - (step M cfg').isNone)) ∧ - (∀ cfg, IsInOdomSystem cfg ↔ - ∃ stk w, cfg = evalOdomR side (q_R stk) pfx_R (encOdom stk) w) ∧ - (∃ (stk₀ : List OdomTok) (w₀ : ListBlank (Fin (k + 2))), - ReachesPlus M (init []) (evalOdomR side (q_R stk₀) pfx_R (encOdom stk₀) w₀) ∧ - 2 ≤ stk₀.length ∧ 1 ≤ cap stk₀) ∧ - (∀ stk w, - ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ - (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) - -/-- Every `TransducerMode` evaluates `(L, R)` as a fixed control state `q` and fixed bounded -`HalfTapeView`s `vL, vR` (`≤ 8`-symbol prefixes) of `encLeft L` and `encRight R` (either scanning -`0` between them or stepping onto the left or right view). -/ -def IsValidTransducerModes {Γ Λ TransducerMode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] - (encLeft : List TokL → ListBlank Γ) - (encRight : List TokR → ListBlank Γ) - (eval : TransducerMode → List TokL → List TokR → Cfg Γ Λ) : Prop := - ∀ m : TransducerMode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), - (match vL with | .id p => p.length ≤ 8 | .tail p => p.length ≤ 8) ∧ - (match vR with | .id p => p.length ≤ 8 | .tail p => p.length ≤ 8) ∧ - ((∀ L R, eval m L R = - ⟨some q, ⟨(0 : Γ), applyView vL (encLeft L), applyView vR (encRight R)⟩⟩) ∨ - (∀ L R, eval m L R = Cfg.headLeft q (applyView vL (encLeft L)) (applyView vR (encRight R))) ∨ - (∀ L R, eval m L R = Cfg.headRight q (applyView vL (encLeft L)) (applyView vR (encRight R)))) - -/-- Scaled integer Kraft-McMillan weight `∑_{t ∈ toks} base ^ (maxLen - (word t).length)`. -/ -@[reducible, simp] -def kraftSum {Tok Γ : Type*} (base maxLen : ℕ) (word : Tok → List Γ) : List Tok → ℕ - | [] => 0 - | t :: ts => base ^ (maxLen - (word t).length) + kraftSum base maxLen word ts - -/-- Iterate a partial macro-transducer step `stepMacro` for `n` macro-steps. -/ -@[reducible, simp] -def iterTransducerMacro {Mode TokL TokR : Type*} - (stepMacro : Mode → List TokL → List TokR → Option (Mode × List TokL × List TokR)) : - ℕ → (Mode × List TokL × List TokR) → Option (Mode × List TokL × List TokR) - | 0, s => some s - | n + 1, (m, L, R) => - match stepMacro m L R with - | none => none - | some s' => iterTransducerMacro stepMacro n s' - -/-- The blank-tape trajectory of `M` is governed by a closed, full-tape, strict-sub-Kraft -finite-alphabet word-stack transducer (`TransducerMode`, `TokL`, `TokR`, `stepMacro`) with bounded -blank-tape entry, `512..2048`-step stack expansion, full constructor orbit reachability, a single -boundary-closed halting exit gate, and orbit-exercised bidirectional multi-bit block-transduction -sweeps. -/ -def HasTransducerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] - (M : Machine (Fin (k + 2)) Λ) : Prop := - ∃ (TransducerMode TokL TokR : Type) - (baseL baseR : List (Fin (k + 2))) - (wordL : TokL → List (Fin (k + 2))) - (wordR : TokR → List (Fin (k + 2))) - (encLeft : List TokL → ListBlank (Fin (k + 2))) - (encRight : List TokR → ListBlank (Fin (k + 2))) - (evalTransducerCfg : TransducerMode → List TokL → List TokR → Cfg (Fin (k + 2)) Λ) - (stepMacro : TransducerMode → List TokL → List TokR → - Option (TransducerMode × List TokL × List TokR)) - (IsInTransducerSystem : Cfg (Fin (k + 2)) Λ → Prop), - (∃ modes : List TransducerMode, - 2 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : TransducerMode, m ∈ modes) ∧ - (∃ (toksL : List TokL) (maxLenL : ℕ), - toksL.Nodup ∧ (toksL.map wordL).Nodup ∧ maxLenL ≤ 8 ∧ - 2 ≤ toksL.length ∧ toksL.length ≤ 8 ∧ (∀ t : TokL, t ∈ toksL) ∧ - (∀ t : TokL, 1 ≤ (wordL t).length ∧ (wordL t).length ≤ maxLenL) ∧ - kraftSum (k + 2) maxLenL wordL toksL < (k + 2) ^ maxLenL) ∧ - (∃ (toksR : List TokR) (maxLenR : ℕ), - toksR.Nodup ∧ (toksR.map wordR).Nodup ∧ maxLenR ≤ 8 ∧ - 2 ≤ toksR.length ∧ toksR.length ≤ 8 ∧ (∀ t : TokR, t ∈ toksR) ∧ - (∀ t : TokR, 1 ≤ (wordR t).length ∧ (wordR t).length ≤ maxLenR) ∧ - kraftSum (k + 2) maxLenR wordR toksR < (k + 2) ^ maxLenR) ∧ - baseL.length ≤ 8 ∧ baseR.length ≤ 8 ∧ - ((∀ t : TokL, 2 ≤ (wordL t).length) ∨ (∀ t : TokR, 2 ≤ (wordR t).length)) ∧ - (∃ t : TokL, (0 : Fin (k + 2)) ∈ wordL t ∧ ∃ a, a ∈ wordL t ∧ a ≠ 0) ∧ - (∃ t : TokR, (0 : Fin (k + 2)) ∈ wordR t ∧ ∃ a, a ∈ wordR t ∧ a ≠ 0) ∧ - encLeft [] = ListBlank.append baseL default ∧ - (∀ t L, encLeft (t :: L) = ListBlank.append (wordL t) (encLeft L)) ∧ - encRight [] = ListBlank.append baseR default ∧ - (∀ t R, encRight (t :: R) = ListBlank.append (wordR t) (encRight R)) ∧ - (∃ t : ListBlank (Fin (k + 2)), ∀ L : List TokL, encLeft L ≠ t) ∧ - (∃ t : ListBlank (Fin (k + 2)), ∀ R : List TokR, encRight R ≠ t) ∧ - IsValidTransducerModes encLeft encRight evalTransducerCfg ∧ - (∀ cfg, IsInTransducerSystem cfg ↔ ∃ m L R, cfg = evalTransducerCfg m L R) ∧ - (∀ m L R m' L' R', - stepMacro m L R = some (m', L', R') → - ReachesPlus M (evalTransducerCfg m L R) (evalTransducerCfg m' L' R')) ∧ - ∃ (m₀ : TransducerMode) (L₀ : List TokL) (R₀ : List TokR), - L₀.length + R₀.length ≤ 4 ∧ - ReachesPlus M (init []) (evalTransducerCfg m₀ L₀ R₀) ∧ - (∃ (n_grow : ℕ) (m_g : TransducerMode) (L_g : List TokL) (R_g : List TokR), - 512 ≤ n_grow ∧ n_grow ≤ 2048 ∧ - iterTransducerMacro stepMacro n_grow (m₀, L₀, R₀) = some (m_g, L_g, R_g) ∧ - 20 ≤ L_g.length + R_g.length) ∧ - (∀ m : TransducerMode, ∃ (n_m : ℕ) (L_m : List TokL) (R_m : List TokR), - n_m ≤ 256 ∧ - iterTransducerMacro stepMacro n_m (m₀, L₀, R₀) = some (m, L_m, R_m)) ∧ - (∀ t : TokL, ∃ (n_t : ℕ) (m_t : TransducerMode) (L_t : List TokL) (R_t : List TokR), - n_t ≤ 256 ∧ - iterTransducerMacro stepMacro n_t (m₀, L₀, R₀) = some (m_t, L_t, R_t) ∧ - t ∈ L_t) ∧ - (∀ t : TokR, ∃ (n_t : ℕ) (m_t : TransducerMode) (L_t : List TokL) (R_t : List TokR), - n_t ≤ 256 ∧ - iterTransducerMacro stepMacro n_t (m₀, L₀, R₀) = some (m_t, L_t, R_t) ∧ - t ∈ R_t) ∧ - ((∃ (m_exit : TransducerMode) (tL_exit : TokL) (exitNext : List TokL), - exitNext.Nodup ∧ exitNext ≠ [] ∧ - (∀ R : List TokR, (stepMacro m_exit [tL_exit] R).isSome) ∧ - (∀ m L R, - stepMacro m L R = none ↔ - (m = m_exit ∧ ∃ t₂ L'', t₂ ∈ exitNext ∧ L = tL_exit :: t₂ :: L'')) ∧ - (∀ t₂ ∈ exitNext, ∀ R : List TokR, ∃ cfg_h, - ReachesPlus M (evalTransducerCfg m_exit [tL_exit, t₂] R) cfg_h ∧ - (step M cfg_h).isNone) ∧ - (∀ t₂ ∈ exitNext, ∃ sfx : List TokL, sfx.length ≤ 2 ∧ - ∀ (L'' : List TokL) (R : List TokR), ∃ cfg_h, - ReachesPlus M (evalTransducerCfg m_exit (tL_exit :: t₂ :: (sfx ++ L'')) R) cfg_h ∧ - (step M cfg_h).isNone)) ∨ - (∃ (m_exit : TransducerMode) (tR_exit : TokR) (exitNext : List TokR), - exitNext.Nodup ∧ exitNext ≠ [] ∧ - (∀ L : List TokL, (stepMacro m_exit L [tR_exit]).isSome) ∧ - (∀ m L R, - stepMacro m L R = none ↔ - (m = m_exit ∧ ∃ t₂ R'', t₂ ∈ exitNext ∧ R = tR_exit :: t₂ :: R'')) ∧ - (∀ t₂ ∈ exitNext, ∀ L : List TokL, ∃ cfg_h, - ReachesPlus M (evalTransducerCfg m_exit L [tR_exit, t₂]) cfg_h ∧ - (step M cfg_h).isNone) ∧ - (∀ t₂ ∈ exitNext, ∃ sfx : List TokR, sfx.length ≤ 2 ∧ - ∀ (L : List TokL) (R'' : List TokR), ∃ cfg_h, - ReachesPlus M (evalTransducerCfg m_exit L (tR_exit :: t₂ :: (sfx ++ R''))) cfg_h ∧ - (step M cfg_h).isNone))) ∧ - (∃ (m_lr m_rl : TransducerMode) (tL tL' : TokL) (tR tR' : TokR) (s₁ s₂ s₃ s₄ : ℕ), - 1 ≤ s₁ ∧ s₁ ≤ 4 ∧ 1 ≤ s₂ ∧ s₂ ≤ 4 ∧ - 1 ≤ s₃ ∧ s₃ ≤ 4 ∧ 1 ≤ s₄ ∧ s₄ ≤ 4 ∧ - 2 ≤ (wordL tL).length ∧ 2 ≤ (wordR tR).length ∧ - 2 ≤ (wordL tL').length ∧ 2 ≤ (wordR tR').length ∧ - (((wordL tL) ^ s₁).reverse ≠ (wordR tR) ^ s₂ ∨ - ((wordR tR') ^ s₃).reverse ≠ (wordL tL') ^ s₄) ∧ - (wordL tL ≠ wordL tL' ∨ wordR tR ≠ wordR tR' ∨ s₁ ≠ s₂ ∨ s₃ ≠ s₄) ∧ - (∃ (n_lr : ℕ) (L_lr : List TokL) (R_lr : List TokR), - n_lr ≤ 256 ∧ - iterTransducerMacro stepMacro n_lr (m₀, L₀, R₀) = some (m_lr, L_lr, R_lr) ∧ - L_lr.take (2 * s₁) = List.replicate (2 * s₁) tL) ∧ - (∃ (n_rl : ℕ) (L_rl : List TokL) (R_rl : List TokR), - n_rl ≤ 256 ∧ - iterTransducerMacro stepMacro n_rl (m₀, L₀, R₀) = some (m_rl, L_rl, R_rl) ∧ - R_rl.take (2 * s₃) = List.replicate (2 * s₃) tR') ∧ - (∀ (n : ℕ) (L : List TokL) (R : List TokR), - ReachesPlus M - (evalTransducerCfg m_lr (List.replicate (s₁ * (n + 1)) tL ++ L) R) - (evalTransducerCfg m_lr L (List.replicate (s₂ * (n + 1)) tR ++ R))) ∧ - (∀ (n : ℕ) (L : List TokL) (R : List TokR), - ReachesPlus M - (evalTransducerCfg m_rl L (List.replicate (s₃ * (n + 1)) tR' ++ R)) - (evalTransducerCfg m_rl (List.replicate (s₄ * (n + 1)) tL' ++ L) R))) - - - - -end BusyBeaver diff --git a/BusyBeaver/Defs/Core.lean b/BusyBeaver/Defs/Core.lean new file mode 100644 index 00000000..24aa392c --- /dev/null +++ b/BusyBeaver/Defs/Core.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Mathlib.Computability.TuringMachine.PostTuringMachine +public import Mathlib.Data.List.Basic +public import Mathlib.Data.Nat.Basic + +/-! +# Core Turing Machine Semantics (`BusyBeaver.Defs.Core`) + +Canonical Post-Turing machine execution model, configuration reachability, and halting +predicates for Busy Beaver holdouts: + +- `Stmt` — atomic tape write-and-move action. +- `Machine` — Post-Turing transition function. +- `Cfg` — machine configuration (optional state + doubly-infinite tape). +- `Cfg.headRight`, `Cfg.headLeft` — directed-head configuration constructors. +- `step` — single-step execution semantics. +- `init` — initial configuration on a given tape prefix. +- `multiStep` — `n`-step execution semantics. +- `ReachesIn` — exact `n`-step reachability. +- `ReachesStar` — reflexive-transitive multi-step reachability. +- `ReachesPlus` — positive-step multi-step reachability. +- `instHPowListNat` — finite list repetition `l ^ n`. +- `IsHaltingConfiguration` — configuration with no valid next step. +- `IsHalt` — blank-tape halting predicate. +- `IsNotHalt` (`IsDoesNotHalt`) — blank-tape non-halting predicate. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- A Turing machine statement writing `symbol` and moving the tape head in direction `dir`. -/ +structure Stmt (Γ : Type*) where + /-- Construct a write-and-move statement. -/ + write :: + /-- Symbol written to the tape cell under the head. -/ + symbol : Γ + /-- Direction in which the tape head moves after writing. -/ + dir : Dir + deriving Inhabited + +/-- A Post-Turing machine with symbol type `Γ` and state label type `Λ`. -/ +@[nolint unusedArguments] +def Machine (Γ Λ : Type*) [Inhabited Λ] := + Λ → Γ → Option (Option Λ × Stmt Γ) + +omit [Inhabited Γ] in +instance Machine.inhabited : Inhabited (Machine Γ Λ) := by + unfold Machine; infer_instance + +/-- Instantaneous configuration of a Turing machine: optional control state `q` and `tape`. -/ +@[ext] +structure Cfg (Γ Λ : Type*) [Inhabited Γ] where + /-- Current control state (`none` represents an explicit terminal state). -/ + q : Option Λ + /-- Current doubly-infinite tape centered at the head. -/ + tape : Tape Γ + +instance Cfg.inhabited : Inhabited (Cfg Γ Λ) := ⟨⟨default, default⟩⟩ + +/-- Configuration in state `q` with the tape head reading the first symbol of `r`. -/ +@[reducible] def Cfg.headRight {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := + ⟨some q, ⟨r.head, l, r.tail⟩⟩ + +/-- Configuration in state `q` with the tape head reading the first symbol of `l`. -/ +@[reducible] def Cfg.headLeft {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := + ⟨some q, ⟨l.head, l.tail, r⟩⟩ + +/-- Single-step execution semantics of a `BusyBeaver.Machine`. -/ +def step (M : Machine Γ Λ) : Cfg Γ Λ → Option (Cfg Γ Λ) + | ⟨none, _⟩ => none + | ⟨some q, T⟩ => + (M q T.1).map fun ⟨q', a⟩ ↦ + ⟨q', match a with | Stmt.write a d => (T.write a).move d⟩ + +/-- Initial configuration on tape prefix `l` (all-blank tape when `l = []`). -/ +def init (l : List Γ) : Cfg Γ Λ := ⟨some default, Tape.mk₁ l⟩ + +/-- Multi-step execution semantics (`n` steps). -/ +def multiStep (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : ℕ) : Option (Cfg Γ Λ) := + (Option.bind · (step M))^[n] config + +/-- Exact `n`-step reachability (`multiStep M c₁ n = some c₂`). -/ +def ReachesIn (M : Machine Γ Λ) (n : ℕ) (c₁ c₂ : Cfg Γ Λ) : Prop := + multiStep M c₁ n = some c₂ + +/-- Reflexive-transitive multi-step reachability (`∃ n, multiStep M c₁ n = some c₂`). -/ +def ReachesStar (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := + ∃ n, multiStep M c₁ n = some c₂ + +/-- Non-empty transitive multi-step reachability (`∃ n > 0, multiStep M c₁ n = some c₂`). -/ +def ReachesPlus (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := + ∃ n > 0, multiStep M c₁ n = some c₂ + +scoped notation3 c₁ " [" M "]⊢ " c₂ => step M c₁ = some c₂ +scoped notation3 c₁ " [" M "]⊢^{" n "} " c₂ => multiStep M c₁ n = some c₂ +scoped notation3 c₁ " [" M "]⊢* " c₂ => ReachesStar M c₁ c₂ +scoped notation3 c₁ " [" M "]⊢⁺ " c₂ => ReachesPlus M c₁ c₂ + +scoped notation l " {{" s "}} " r => (⟨s, l, r⟩ : Tape _) +scoped notation:67 s:67 " << " a:68 => ListBlank.cons a s +scoped infixr:67 " >> " => ListBlank.cons +scoped notation:67 s:67 " <+ " l:68 => ListBlank.append l s +scoped infixr:67 " +> " => ListBlank.append +scoped notation3 l " {{" q "}}> " r => (⟨some q, ⟨ListBlank.head r, l, ListBlank.tail r⟩⟩ : Cfg _ _) +scoped notation3 l " <{{" q "}} " r => (⟨some q, ⟨ListBlank.head l, ListBlank.tail l, r⟩⟩ : Cfg _ _) + +/-- Repeat finite list `l` `n` times (`l ^ n`). -/ +instance instHPowListNat : HPow (List Γ) ℕ (List Γ) := + ⟨fun l n => (List.replicate n l).flatten⟩ + +/-- A configuration is halting for `M` if no next transition is defined. -/ +def IsHaltingConfiguration (M : Machine Γ Λ) (cfg : Cfg Γ Λ) : Prop := + (step M cfg).isNone + +/-- `M` eventually reaches a halting configuration when started on the blank tape (`init []`). -/ +def IsHalt (M : Machine Γ Λ) : Prop := + ∃ cfg : Cfg Γ Λ, ReachesStar M (init []) cfg ∧ (step M cfg).isNone + +/-- `M` never halts when started on the blank tape (`init []`). -/ +def IsNotHalt (M : Machine Γ Λ) : Prop := + ∀ cfg : Cfg Γ Λ, ReachesStar M (init []) cfg → (step M cfg).isSome + +/-- Alias for `IsNotHalt`. -/ +abbrev IsDoesNotHalt (M : Machine Γ Λ) : Prop := IsNotHalt M + + + +/-- Atomic `NeZero (k + 2)` instance for alphabet size `Fin (k + 2)`. +Ensures `HasStackReduction` and `HasOdometerReduction` synthesize an atomic constant +rather than composite proof `instNeZeroNatHAdd_1 k 2`, avoiding per-module `_proof_1` +auxiliary definitions that break cross-module AST equality in the comparator. +Priority `default + 1` is required because at default priority Lean prioritizes +Mathlib's composite `instNeZeroNatHAdd_1`. -/ +instance (priority := default + 1) instNeZeroK2 (k : ℕ) : @NeZero ℕ Zero.ofOfNat0 (k + 2) := + ⟨Nat.succ_ne_zero (k + 1)⟩ + +/-- Atomic `NeZero 2` instance with higher priority than `instNeZeroK2`. +Ensures literal `Fin 2` does not match `instNeZeroK2 0`, which would embed a dependency +on `0` into the typeclass instance and break `generalize 0 = n` in downstream proofs. -/ +instance (priority := default + 2) instNeZeroTwoLit : @NeZero ℕ Zero.ofOfNat0 2 := + ⟨Nat.succ_ne_zero 1⟩ + +end BusyBeaver diff --git a/BusyBeaver/Defs/Odometer.lean b/BusyBeaver/Defs/Odometer.lean new file mode 100644 index 00000000..ba03d1e6 --- /dev/null +++ b/BusyBeaver/Defs/Odometer.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Defs.Core + +/-! +# Mixed-Radix Odometer Systems (`BusyBeaver.Defs.Odometer`) + +Mixed-radix odometer-word hub systems: + +- `OdomSide` — odometer stack tape orientation. +- `evalOdomR`, `evalOdomL` — outward-facing and inward-facing configuration evaluators. +- `HasOdometerReduction` — mixed-radix odometer reduction. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Tape orientation for a mixed-radix odometer-word system (`HasOdometerReduction`). -/ +inductive OdomSide where + /-- Odometer stack on the left half-tape and active word on the right half-tape. -/ + | leftOdom + /-- Odometer stack on the right half-tape and active word on the left half-tape. -/ + | rightOdom + +/-- Evaluate the outward-facing hub configuration (head at `q_R` facing the active word `w` across +fixed boundary prefix `pfx_R`). -/ +@[reducible, simp] +def evalOdomR {Γ Λ : Type*} [Inhabited Γ] + (side : OdomSide) (q_R : Λ) (pfx_R : List Γ) + (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := + match side with + | .leftOdom => Cfg.headRight q_R (ListBlank.append pfx_R encOdom) w + | .rightOdom => Cfg.headLeft q_R w (ListBlank.append pfx_R encOdom) + +/-- Evaluate the inward-facing odometer entry configuration (head at `q_L` facing the odometer +stack `encOdom` across fixed boundary prefix `pfx_L`). -/ +@[reducible, simp] +def evalOdomL {Γ Λ : Type*} [Inhabited Γ] + (side : OdomSide) (q_L : Λ) (pfx_L : List Γ) + (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := + match side with + | .leftOdom => Cfg.headLeft q_L encOdom (ListBlank.append pfx_L w) + | .rightOdom => Cfg.headRight q_L (ListBlank.append pfx_L w) encOdom + +/-- The blank-tape trajectory of `M` enters a closed outward-facing odometer-word hub coupled with +a non-surjective multi-bit mixed-radix odometer stack (`OdomTok`, `cap`, `dec`, `drain`) supporting +odd-doubling (`2c + 1`), even-doubling (`2c`), and base-`b` division (`c / b`, `b ≥ 2`) frames, +universal capacity decrement (`cap stk ≥ 1`) and full-stack drain (`cap stk = 0`), active `0`-bit +reflection, and push/reflect/halt closure under `ReachesPlus`. -/ +def HasOdometerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (OdomTok : Type) + (side : OdomSide) + (q_R : List OdomTok → Λ) + (q_L : Λ) + (pfx_R pfx_L odomBase : List (Fin (k + 2))) + (odomWord : OdomTok → List (Fin (k + 2))) + (encOdom : List OdomTok → ListBlank (Fin (k + 2))) + (cap : List OdomTok → ℕ) + (dec : List OdomTok → List OdomTok) + (decPfx : List OdomTok → List (Fin (k + 2))) + (drain : List OdomTok → List (Fin (k + 2))) + (IsInOdomSystem : Cfg (Fin (k + 2)) Λ → Prop), + (∃ toks : List OdomTok, 2 ≤ toks.length ∧ toks.length ≤ 6 ∧ ∀ t : OdomTok, t ∈ toks) ∧ + odomBase ≠ [] ∧ + (∀ t : OdomTok, 2 ≤ (odomWord t).length) ∧ + encOdom [] = ListBlank.append odomBase default ∧ + (∀ t stk, encOdom (t :: stk) = ListBlank.append (odomWord t) (encOdom stk)) ∧ + (∃ t : ListBlank (Fin (k + 2)), ∀ stk : List OdomTok, encOdom stk ≠ t) ∧ + cap [] = 0 ∧ + (∃ (t_inc t_even t_div : OdomTok) (b : ℕ) (blk_inc blk_div : List (Fin (k + 2))), + 2 ≤ b ∧ 2 ≤ blk_inc.length ∧ 2 ≤ blk_div.length ∧ + (∀ stk, cap (t_inc :: stk) = 2 * cap stk + 1) ∧ + (∀ stk, cap (t_even :: stk) = 2 * cap stk) ∧ + (∀ stk, cap (t_div :: stk) = cap stk / b) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_inc w)) + (evalOdomR side (q_R (t_inc :: stk)) pfx_R (encOdom (t_inc :: stk)) w)) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_div w)) + (evalOdomR side (q_R (t_div :: stk)) pfx_R (encOdom (t_div :: stk)) w))) ∧ + (∀ stk, (dec stk).length = stk.length) ∧ + (∀ stk, cap stk ≥ 1 → cap (dec stk) = cap stk - 1) ∧ + (∀ stk w, cap stk ≥ 1 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R (dec stk)) pfx_R (encOdom (dec stk)) + (ListBlank.append (decPfx stk) w))) ∧ + (∀ stk, cap stk = 0 → drain stk ≠ []) ∧ + (∀ stk w, cap stk = 0 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R []) pfx_R (encOdom []) (ListBlank.append (drain stk) w))) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.cons (0 : Fin (k + 2)) w)) + (evalOdomL side q_L pfx_L (encOdom stk) (ListBlank.cons (1 : Fin (k + 2)) w))) ∧ + (∀ stk w, + (∃ t w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomR side (q_R (t :: stk)) pfx_R (encOdom (t :: stk)) w')) ∨ + (∃ w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomL side q_L pfx_L (encOdom stk) w')) ∨ + (∃ cfg', + ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (step M cfg').isNone)) ∧ + (∀ cfg, IsInOdomSystem cfg ↔ + ∃ stk w, cfg = evalOdomR side (q_R stk) pfx_R (encOdom stk) w) ∧ + (∃ (stk₀ : List OdomTok) (w₀ : ListBlank (Fin (k + 2))), + ReachesPlus M (init []) (evalOdomR side (q_R stk₀) pfx_R (encOdom stk₀) w₀) ∧ + 2 ≤ stk₀.length ∧ 1 ≤ cap stk₀) ∧ + (∀ stk w, + ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) + +end BusyBeaver diff --git a/BusyBeaver/Defs/Patterns.lean b/BusyBeaver/Defs/Patterns.lean new file mode 100644 index 00000000..cba6e771 --- /dev/null +++ b/BusyBeaver/Defs/Patterns.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Defs.Core + +/-! +# Accelerated Pattern Set Reductions (`BusyBeaver.Defs.Patterns`) + +Parametric regular-expression tape patterns and Collatz-like acceleration semantics: + +- `TapeExpr` — parametric regular-expression half-tape expressions. +- `evalTapeExpr` — evaluation of a tape expression under a variable valuation. +- `TapePattern` — parametric full-tape configuration pattern. +- `evalTapePattern` — evaluation of a tape pattern under a variable valuation. +- `VarCond` — guard conditions over pattern variables. +- `evalVarCond` — satisfaction of guard conditions. +- `TapePatternSet` — finite list of guarded tape patterns. +- `IsInPatternSet` — configuration membership in a pattern set. +- `IsClosedPatternSet` — inductive closure of a pattern set under accelerated execution. +- `HasCollatzReduction` — existence of a closed pattern set. +- `CollatzHalts` — halting predicate for abstract transition systems. +- `IsValidAcceleration` — sound simulation by a Collatz-like acceleration system. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Parametric regular-expression half-tape expressions for `HasCollatzReduction`. -/ +inductive TapeExpr (Γ : Type*) where + /-- All-blank tail (`default : ListBlank Γ`). -/ + | default : TapeExpr Γ + /-- Single symbol `a` followed by `rest`. -/ + | sym (a : Γ) (rest : TapeExpr Γ) + /-- Finite block `blk` repeated `vars var_idx` times followed by `rest`. -/ + | rep (blk : List Γ) (var_idx : ℕ) (rest : TapeExpr Γ) + +/-- Evaluate a `TapeExpr Γ` under variable assignment `vars : ℕ → ℕ`. -/ +def evalTapeExpr {Γ : Type*} [Inhabited Γ] : TapeExpr Γ → (ℕ → ℕ) → ListBlank Γ + | .default, _ => default + | .sym a rest, vars => ListBlank.cons a (evalTapeExpr rest vars) + | .rep blk v rest, vars => ListBlank.append (blk ^ vars v) (evalTapeExpr rest vars) + +/-- Parametric full-tape configuration pattern. -/ +structure TapePattern (Γ Λ : Type*) where + /-- Left half-tape expression. -/ + left : TapeExpr Γ + /-- Control state (`some q` or `none`). -/ + head : Option Λ + /-- Right half-tape expression (whose head is under the tape head). -/ + right : TapeExpr Γ + +/-- Evaluate a `TapePattern Γ Λ` under variable assignment `vars : ℕ → ℕ`. -/ +def evalTapePattern {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (p : TapePattern Γ Λ) (vars : ℕ → ℕ) : Cfg Γ Λ := + let r := evalTapeExpr p.right vars + ⟨p.head, ⟨r.head, evalTapeExpr p.left vars, r.tail⟩⟩ + +/-- Guard condition over `ℕ`-valued pattern variables. -/ +inductive VarCond where + /-- `vars idx ≥ val`. -/ + | ge_const (idx : ℕ) (val : ℕ) + /-- `vars idx1 ≥ vars idx2`. -/ + | ge_var (idx1 idx2 : ℕ) + /-- Conjunction of conditions. -/ + | and (c1 c2 : VarCond) + /-- Disjunction of conditions. -/ + | or (c1 c2 : VarCond) + /-- Negation of a condition. -/ + | not (c : VarCond) + /-- Trivially satisfied condition. -/ + | true + +/-- Evaluate a `VarCond` under variable assignment `vars : ℕ → ℕ`. -/ +def evalVarCond : VarCond → (ℕ → ℕ) → Prop + | .ge_const idx val, vars => vars idx ≥ val + | .ge_var idx1 idx2, vars => vars idx1 ≥ vars idx2 + | .and c1 c2, vars => evalVarCond c1 vars ∧ evalVarCond c2 vars + | .or c1 c2, vars => evalVarCond c1 vars ∨ evalVarCond c2 vars + | .not c, vars => ¬ evalVarCond c vars + | .true, _ => True + +/-- Finite list of guarded tape patterns. -/ +abbrev TapePatternSet (Γ Λ : Type*) := List (TapePattern Γ Λ × VarCond) + +/-- Membership of configuration `cfg` in a `TapePatternSet`. -/ +def IsInPatternSet {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (ps : TapePatternSet Γ Λ) (cfg : Cfg Γ Λ) : Prop := + ∃ entry : TapePattern Γ Λ × VarCond, entry ∈ ps ∧ + ∃ vars : ℕ → ℕ, cfg = evalTapePattern entry.1 vars ∧ evalVarCond entry.2 vars + +/-- `ps` is a closed accelerated `TapePatternSet` for `M` if `M`'s blank-tape trajectory enters +`ps` and every member configuration of `ps` steps in `ReachesPlus` (`n > 0` steps) either to +another member of `ps` or to a halting configuration. -/ +def IsClosedPatternSet (M : Machine Γ Λ) (ps : TapePatternSet Γ Λ) : Prop := + (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInPatternSet ps cfg₀) ∧ + (∀ cfg, IsInPatternSet ps cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ + (IsInPatternSet ps cfg' ∨ (step M cfg').isNone)) + +/-- `M`'s blank-tape trajectory enters a closed accelerated `TapePatternSet` in which every +member configuration steps in `ReachesPlus` either to another member or to a halting state. -/ +def HasCollatzReduction (M : Machine Γ Λ) : Prop := + ∃ ps : TapePatternSet Γ Λ, IsClosedPatternSet M ps + +/-- An abstract partial transition system `next : S → Option S` halts from `s₀ : S` if iterating +`next` from `some s₀` eventually produces `none`. -/ +def CollatzHalts {S : Type*} (next : S → Option S) (s₀ : S) : Prop := + ∃ n : ℕ, ((Option.bind · next)^[n] (some s₀)).isNone + +/-- `encode`, `next`, and `start` form a valid Collatz-like acceleration of `M` when: +1. `M` reaches `encode start` from the blank tape (`init []`), +2. Every defined step `next s = some s'` takes `M` from `encode s` to `encode s'` in `ReachesPlus` + (at least one raw Turing machine step), and +3. Every undefined step `next s = none` means `M` reaches a halting configuration from + `encode s`. -/ +structure IsValidAcceleration (M : Machine Γ Λ) {S : Type*} + (start : S) (encode : S → Cfg Γ Λ) (next : S → Option S) : Prop where + /-- `M` reaches `encode start` from the blank tape (`init []`). -/ + init_reaches : ReachesStar M (init []) (encode start) + /-- Every non-halting accelerated step takes at least one Turing machine step. -/ + step_some : ∀ s s', next s = some s' → ReachesPlus M (encode s) (encode s') + /-- Every halting accelerated state reaches a halting Turing machine configuration. -/ + step_none : ∀ s, next s = none → + ∃ cfg', ReachesStar M (encode s) cfg' ∧ (step M cfg').isNone + +end BusyBeaver diff --git a/BusyBeaver/Defs/Stack.lean b/BusyBeaver/Defs/Stack.lean new file mode 100644 index 00000000..0ab9304d --- /dev/null +++ b/BusyBeaver/Defs/Stack.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Defs.Core +public import BusyBeaver.Defs.Patterns + +/-! +# Stack-Word Tape Patterns and Stack Reductions (`BusyBeaver.Defs.Stack`) + +Stack-word tape pattern expressions, stacked Collatz reductions, and 2nd-order digit-stack systems: + +- `StackSeg` — parametric half-tape segment with variable-length stack words. +- `StackSeg.isWord`, `StackSeg.WellFormed` — stack segment predicates. +- `StackExpr`, `evalStackExpr` — parametric stack-word half-tape expressions. +- `StackPattern`, `StackPattern.WellFormed`, `evalStackPattern` — stack configuration patterns. +- `StackPatternSet`, `IsWellFormedStackPatternSet`, `IsInStackPatternSet` — stack pattern sets. +- `IsClosedStackPatternSet`, `HasStackedCollatzReduction` — stacked Collatz reductions. +- `HalfTapeView`, `applyView` — bounded half-tape view selectors. +- `StackTuple`, `stackDigit`, `stackSepLen` — tuple stacks and separator lengths. +- `IsValidStackPolarity` — digit/separator symbol polarity. +- `IsValidStackModes` — bounded-prefix stack mode views. +- `HasStackReduction` — 2nd-order digit-stack reduction. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Parametric half-tape segment for `HasStackedCollatzReduction`: in addition to single symbols +and repeated blocks, a `.word words stack_idx` segment expands a variable-length stack word +`stacks stack_idx : List ℕ` over a finite block vocabulary `words : List (List Γ)`. -/ +inductive StackSeg (Γ : Type*) where + /-- Single symbol `a`. -/ + | sym (a : Γ) + /-- Finite block `blk` repeated `vars var_idx` times. -/ + | rep (blk : List Γ) (var_idx : ℕ) + /-- Stack word `stacks stack_idx` expanded over block vocabulary `words`. -/ + | word (words : List (List Γ)) (stack_idx : ℕ) + +/-- Whether a `StackSeg Γ` is a `.word` stack segment. -/ +def StackSeg.isWord {Γ : Type*} : StackSeg Γ → Bool + | .word _ _ => true + | _ => false + +/-- A `StackSeg Γ` is well-formed when every repeated block or stack-vocabulary block is non-empty +and contains no blank (`default`) symbols, and every `.word` vocabulary is non-empty. -/ +def StackSeg.WellFormed {Γ : Type*} [Inhabited Γ] [DecidableEq Γ] : StackSeg Γ → Bool + | .sym _ => true + | .rep blk _ => !blk.isEmpty && blk.all (· != default) + | .word words _ => !words.isEmpty && words.all (fun w => !w.isEmpty && w.all (· != default)) + +/-- Parametric stack-word half-tape expression (evaluated from head to blank tail). -/ +abbrev StackExpr (Γ : Type*) := List (StackSeg Γ) + +/-- Evaluate a single `StackSeg Γ` under counter assignment `vars : ℕ → ℕ` and stack assignment +`stks : ℕ → List ℕ`. -/ +def evalStackSeg {Γ : Type*} : StackSeg Γ → (ℕ → ℕ) → (ℕ → List ℕ) → List Γ + | .sym a, _, _ => [a] + | .rep blk v, vars, _ => blk ^ vars v + | .word words s, _, stks => ((stks s).map (fun d => words.getD d [])).flatten + +/-- Evaluate a `StackExpr Γ` under counter assignment `vars : ℕ → ℕ` and stack assignment +`stks : ℕ → List ℕ`. -/ +def evalStackExpr {Γ : Type*} [Inhabited Γ] : + StackExpr Γ → (ℕ → ℕ) → (ℕ → List ℕ) → ListBlank Γ + | [], _, _ => default + | seg :: rest, vars, stks => + ListBlank.append (evalStackSeg seg vars stks) (evalStackExpr rest vars stks) + +/-- Parametric stack-word full-tape configuration pattern. -/ +structure StackPattern (Γ Λ : Type*) where + /-- Left half-tape expression. -/ + left : StackExpr Γ + /-- Control state (`some q` or `none`). -/ + head : Option Λ + /-- Right half-tape expression (whose head is under the tape head). -/ + right : StackExpr Γ + +/-- A `StackPattern Γ Λ` is well-formed when all segments on both half-tapes are well-formed +(non-empty and blank-free blocks), at least one half-tape is empty (single-sided tape boundary), +and at most one `.word` stack segment appears across the pattern. -/ +def StackPattern.WellFormed {Γ Λ : Type*} [Inhabited Γ] [DecidableEq Γ] + (p : StackPattern Γ Λ) : Bool := + p.left.all StackSeg.WellFormed && + p.right.all StackSeg.WellFormed && + (p.left.isEmpty || p.right.isEmpty) && + (decide (p.left.countP StackSeg.isWord + p.right.countP StackSeg.isWord ≤ 1)) + +/-- Evaluate a `StackPattern Γ Λ` under counter assignment `vars : ℕ → ℕ` and stack assignment +`stks : ℕ → List ℕ`. -/ +def evalStackPattern {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (p : StackPattern Γ Λ) (vars : ℕ → ℕ) (stks : ℕ → List ℕ) : Cfg Γ Λ := + let r := evalStackExpr p.right vars stks + ⟨p.head, ⟨r.head, evalStackExpr p.left vars stks, r.tail⟩⟩ + +/-- Finite list of guarded stack-word tape patterns. -/ +abbrev StackPatternSet (Γ Λ : Type*) := List (StackPattern Γ Λ × VarCond) + +/-- A `StackPatternSet Γ Λ` is well-formed when it is non-empty and every pattern in it is +well-formed (`StackPattern.WellFormed`). -/ +def IsWellFormedStackPatternSet {Γ Λ : Type*} [Inhabited Γ] [DecidableEq Γ] + (ps : StackPatternSet Γ Λ) : Prop := + (!ps.isEmpty && ps.all (fun entry => entry.1.WellFormed)) = true + +/-- Membership of configuration `cfg` in a `StackPatternSet`. -/ +def IsInStackPatternSet {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (ps : StackPatternSet Γ Λ) (cfg : Cfg Γ Λ) : Prop := + ∃ entry : StackPattern Γ Λ × VarCond, entry ∈ ps ∧ + ∃ (vars : ℕ → ℕ) (stks : ℕ → List ℕ), + cfg = evalStackPattern entry.1 vars stks ∧ evalVarCond entry.2 vars + +/-- `ps` is a closed accelerated `StackPatternSet` for `M` if `ps` is well-formed +(`IsWellFormedStackPatternSet`), `M`'s blank-tape trajectory enters `ps`, and every member +configuration of `ps` steps in `ReachesPlus` (`n > 0` steps) either to another member of `ps` or +to a halting configuration. + +In `BusyBeaverChallenge.lean`, `IsClosedStackPatternSet` pins an explicit `ps` and is always paired +with a concrete Level B finite-state transducer acceleration (`IsValidAcceleration`). -/ +def IsClosedStackPatternSet [DecidableEq Γ] (M : Machine Γ Λ) (ps : StackPatternSet Γ Λ) : Prop := + IsWellFormedStackPatternSet ps ∧ + (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInStackPatternSet ps cfg₀) ∧ + (∀ cfg, IsInStackPatternSet ps cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ + (IsInStackPatternSet ps cfg' ∨ (step M cfg').isNone)) + +/-- `M`'s blank-tape trajectory enters a well-formed closed accelerated `StackPatternSet` in which +every member configuration steps in `ReachesPlus` either to another member or to a halting state. +This existential summary is always paired in `BusyBeaverChallenge.lean` with a concrete `ps` +(`IsClosedStackPatternSet M ps`) and an explicit Level B finite-state transducer acceleration +(`IsValidAcceleration M start encode next`). -/ +def HasStackedCollatzReduction [DecidableEq Γ] (M : Machine Γ Λ) : Prop := + ∃ ps : StackPatternSet Γ Λ, IsClosedStackPatternSet M ps + +/-- Allowed half-tape views in a separator mode: either a fixed prefix in front of the encoded +stack, or a fixed prefix in front of its `.tail`. -/ +inductive HalfTapeView (Γ : Type*) where + /-- Fixed prefix `pfx` directly in front of the encoded stack. -/ + | id (pfx : List Γ) + /-- Fixed prefix `pfx` in front of the `.tail` of the encoded stack. -/ + | tail (pfx : List Γ) + +/-- Apply a `HalfTapeView Γ` to an encoded half-tape `ListBlank Γ`. -/ +def applyView {Γ : Type*} [Inhabited Γ] : HalfTapeView Γ → ListBlank Γ → ListBlank Γ + | .id pfx, s => ListBlank.append pfx s + | .tail pfx, s => ListBlank.append pfx s.tail + +/-- Right-nested `n`-tuple of natural numbers indexed by the machine's symbol count `n` +(`ℕ × ℕ` for 2-symbol machines, `ℕ × ℕ × ℕ` for 3-symbol machines, etc.). -/ +@[reducible] def StackTuple (n : ℕ) : Type := + Nat.casesOn n Unit (fun m => Nat.rec ℕ (fun _ ih => ℕ × ih) m) + +/-- Primary coordinate of a `StackTuple n`. -/ +@[reducible, simp] def stackDigit {n : ℕ} : StackTuple n → ℕ := + Nat.casesOn (motive := fun n => StackTuple n → ℕ) n + (fun _ => 0) + (fun m => Nat.casesOn (motive := fun m => StackTuple (m + 1) → ℕ) m + (fun a => a) + (fun _ p => p.1)) + +/-- Separator run length for the `(n + 1)`-symbol tail of a `StackTuple (n + 2)`. -/ +@[reducible, simp] def stackSepLen {n : ℕ} (sep maxSep : ℕ) : StackTuple n → ℕ := + Nat.casesOn (motive := fun n => StackTuple n → ℕ) n + (fun _ => 0) + (fun m => Nat.casesOn (motive := fun m => StackTuple (m + 1) → ℕ) m + (fun b => sep + b % maxSep) + (fun k p => (sep + p.1 % maxSep) * stackDigit (n := k + 1) p.2)) + +/-- Valid `(dSym, sSym)` symbol polarity for a `(k + 2)`-symbol machine: for 2-symbol machines +(`k = 0`), `(dSym, sSym) ∈ {(1, 0), (0, 1)}`; for `(k + 3)`-symbol machines (`k ≥ 1`), any +distinct `dSym ≠ sSym`. -/ +@[reducible] def IsValidStackPolarity : {k : ℕ} → Fin (k + 2) → Fin (k + 2) → Prop + | 0, dSym, sSym => + (dSym = (1 : Fin 2) ∧ sSym = (0 : Fin 2)) ∨ (dSym = (0 : Fin 2) ∧ sSym = (1 : Fin 2)) + | _ + 1, dSym, sSym => dSym ≠ sSym + +/-- Every `StackMode` evaluates `(L, R)` as a fixed control state `q` and fixed bounded +`HalfTapeView`s `vL, vR` (`≤ 8`-symbol prefixes) of `encLeft L` and `encRight R` (either scanning +`0` between them or stepping onto the left or right view). -/ +def IsValidStackModes {Γ Λ StackMode α : Type*} [Inhabited Γ] [OfNat Γ 0] + (encLeft encRight : List α → ListBlank Γ) + (eval : StackMode → List α → List α → Cfg Γ Λ) : Prop := + ∀ m : StackMode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), + (HalfTapeView.casesOn vL List.length List.length) ≤ 8 ∧ + (HalfTapeView.casesOn vR List.length List.length) ≤ 8 ∧ + ((∀ L R, eval m L R = + ⟨some q, ⟨(0 : Γ), applyView vL (encLeft L), applyView vR (encRight R)⟩⟩) ∨ + (∀ L R, eval m L R = Cfg.headLeft q (applyView vL (encLeft L)) (applyView vR (encRight R))) ∨ + (∀ L R, eval m L R = Cfg.headRight q (applyView vL (encLeft L)) (applyView vR (encRight R)))) + +/-- The blank-tape trajectory of `M` enters a closed 2nd-order digit-stack configuration family +over `(k + 2)`-symbol tuple stacks `List (StackTuple (k + 2))` with valid symbol polarity, +parametric unary-block stack recurrences (`strideL, offsetL, sepL, strideR, offsetR, sepR > 0`, +`1 ≤ maxSepL, maxSepR ≤ 4`), head-`dSym` non-surjectivity, at most 6 bounded-prefix modes +(`IsValidStackModes`), blank-tape multi-digit stack reachability (`3 ≤ L_g.length + R_g.length` +with a positive digit), an arbitrary-depth stack-frame transfer transition, and closure under +`ReachesPlus` up to halting. -/ +def HasStackReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (StackMode : Type) + (dSym sSym : Fin (k + 2)) + (encLeft encRight : List (StackTuple (k + 2)) → ListBlank (Fin (k + 2))) + (evalStackCfg : + StackMode → List (StackTuple (k + 2)) → List (StackTuple (k + 2)) → Cfg (Fin (k + 2)) Λ) + (IsInStackSystem : Cfg (Fin (k + 2)) Λ → Prop), + IsValidStackPolarity dSym sSym ∧ + encLeft [] = default ∧ + encRight [] = default ∧ + (∀ a b L, (encLeft ((a, b) :: L)).head = dSym) ∧ + (∀ d b R, (encRight ((d, b) :: R)).head = dSym) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ L : List (StackTuple (k + 2)), encLeft L ≠ t) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ R : List (StackTuple (k + 2)), encRight R ≠ t) ∧ + (∃ strideL offsetL sepL maxSepL strideR offsetR sepR maxSepR : ℕ, + strideL > 0 ∧ offsetL > 0 ∧ sepL > 0 ∧ 1 ≤ maxSepL ∧ maxSepL ≤ 4 ∧ + strideR > 0 ∧ offsetR > 0 ∧ sepR > 0 ∧ 1 ≤ maxSepR ∧ maxSepR ≤ 4 ∧ + (∀ a b L, encLeft ((a, b) :: L) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideL * a + offsetL)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepL maxSepL b)) + (encLeft L))) ∧ + (∀ d b R, encRight ((d, b) :: R) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideR * d + offsetR)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepR maxSepR b)) + (encRight R)))) ∧ + (∃ modes : List StackMode, modes.length ≤ 6 ∧ ∀ m : StackMode, m ∈ modes) ∧ + IsValidStackModes encLeft encRight evalStackCfg ∧ + (∀ cfg, IsInStackSystem cfg ↔ ∃ m L R, cfg = evalStackCfg m L R) ∧ + (∀ m L R, IsInStackSystem (evalStackCfg m L R)) ∧ + (∃ (m_g : StackMode) (L_g R_g : List (StackTuple (k + 2))), + ReachesPlus M (init []) (evalStackCfg m_g L_g R_g) ∧ + 3 ≤ L_g.length + R_g.length ∧ + (∃ x ∈ L_g ++ R_g, 1 ≤ x.1)) ∧ + ((∃ (m m' : StackMode) (x : StackTuple (k + 2)) + (g : StackTuple (k + 2) → StackTuple (k + 2)) + (f : List (StackTuple (k + 2)) → List (StackTuple (k + 2))), + (∀ s, s.length ≤ (f s).length) ∧ + ∀ z L R, + ReachesPlus M (evalStackCfg m (x :: z :: L) R) (evalStackCfg m' (g z :: L) (f R))) ∨ + (∃ (m m' : StackMode) (x : StackTuple (k + 2)) + (g : StackTuple (k + 2) → StackTuple (k + 2)) + (f : List (StackTuple (k + 2)) → List (StackTuple (k + 2))), + (∀ s, s.length ≤ (f s).length) ∧ + ∀ z L R, + ReachesPlus M (evalStackCfg m L (x :: z :: R)) (evalStackCfg m' (f L) (g z :: R)))) ∧ + (∀ cfg, IsInStackSystem cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) + +end BusyBeaver diff --git a/BusyBeaver/Defs/Transducer.lean b/BusyBeaver/Defs/Transducer.lean new file mode 100644 index 00000000..97bdeb9b --- /dev/null +++ b/BusyBeaver/Defs/Transducer.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Defs.Core +public import BusyBeaver.Defs.Stack + +/-! +# Word-Stack Transducers (`BusyBeaver.Defs.Transducer`) + +Bidirectional word-stack transducers: + +- `IsValidTransducerModes` — bounded-prefix transducer mode views. +- `kraftSum` — scaled integer Kraft-McMillan weight. +- `iterTransducerMacro` — macro-step iteration. +- `HasTransducerReduction` — strict-sub-Kraft finite-alphabet word-stack transducer reduction. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Every `TransducerMode` evaluates `(L, R)` as a fixed control state `q` and fixed bounded +`HalfTapeView`s `vL, vR` (`≤ 8`-symbol prefixes) of `encLeft L` and `encRight R` (either scanning +`0` between them or stepping onto the left or right view). -/ +def IsValidTransducerModes {Γ Λ TransducerMode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] + (encLeft : List TokL → ListBlank Γ) + (encRight : List TokR → ListBlank Γ) + (eval : TransducerMode → List TokL → List TokR → Cfg Γ Λ) : Prop := + ∀ m : TransducerMode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), + (match vL with | .id p => p.length ≤ 8 | .tail p => p.length ≤ 8) ∧ + (match vR with | .id p => p.length ≤ 8 | .tail p => p.length ≤ 8) ∧ + ((∀ L R, eval m L R = + ⟨some q, ⟨(0 : Γ), applyView vL (encLeft L), applyView vR (encRight R)⟩⟩) ∨ + (∀ L R, eval m L R = Cfg.headLeft q (applyView vL (encLeft L)) (applyView vR (encRight R))) ∨ + (∀ L R, eval m L R = Cfg.headRight q (applyView vL (encLeft L)) (applyView vR (encRight R)))) + +/-- Scaled integer Kraft-McMillan weight `∑_{t ∈ toks} base ^ (maxLen - (word t).length)`. -/ +@[reducible, simp] +def kraftSum {Tok Γ : Type*} (base maxLen : ℕ) (word : Tok → List Γ) : List Tok → ℕ + | [] => 0 + | t :: ts => base ^ (maxLen - (word t).length) + kraftSum base maxLen word ts + +/-- Iterate a partial macro-transducer step `stepMacro` for `n` macro-steps. -/ +@[reducible, simp] +def iterTransducerMacro {Mode TokL TokR : Type*} + (stepMacro : Mode → List TokL → List TokR → Option (Mode × List TokL × List TokR)) : + ℕ → (Mode × List TokL × List TokR) → Option (Mode × List TokL × List TokR) + | 0, s => some s + | n + 1, (m, L, R) => + match stepMacro m L R with + | none => none + | some s' => iterTransducerMacro stepMacro n s' + +/-- The blank-tape trajectory of `M` is governed by a closed, full-tape, strict-sub-Kraft +finite-alphabet word-stack transducer (`TransducerMode`, `TokL`, `TokR`, `stepMacro`) with bounded +blank-tape entry, `512..2048`-step stack expansion, full constructor orbit reachability, a single +boundary-closed halting exit gate, and orbit-exercised bidirectional multi-bit block-transduction +sweeps. -/ +def HasTransducerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (TransducerMode TokL TokR : Type) + (baseL baseR : List (Fin (k + 2))) + (wordL : TokL → List (Fin (k + 2))) + (wordR : TokR → List (Fin (k + 2))) + (encLeft : List TokL → ListBlank (Fin (k + 2))) + (encRight : List TokR → ListBlank (Fin (k + 2))) + (evalTransducerCfg : TransducerMode → List TokL → List TokR → Cfg (Fin (k + 2)) Λ) + (stepMacro : TransducerMode → List TokL → List TokR → + Option (TransducerMode × List TokL × List TokR)) + (IsInTransducerSystem : Cfg (Fin (k + 2)) Λ → Prop), + (∃ modes : List TransducerMode, + 2 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : TransducerMode, m ∈ modes) ∧ + (∃ (toksL : List TokL) (maxLenL : ℕ), + toksL.Nodup ∧ (toksL.map wordL).Nodup ∧ maxLenL ≤ 8 ∧ + 2 ≤ toksL.length ∧ toksL.length ≤ 8 ∧ (∀ t : TokL, t ∈ toksL) ∧ + (∀ t : TokL, 1 ≤ (wordL t).length ∧ (wordL t).length ≤ maxLenL) ∧ + kraftSum (k + 2) maxLenL wordL toksL < (k + 2) ^ maxLenL) ∧ + (∃ (toksR : List TokR) (maxLenR : ℕ), + toksR.Nodup ∧ (toksR.map wordR).Nodup ∧ maxLenR ≤ 8 ∧ + 2 ≤ toksR.length ∧ toksR.length ≤ 8 ∧ (∀ t : TokR, t ∈ toksR) ∧ + (∀ t : TokR, 1 ≤ (wordR t).length ∧ (wordR t).length ≤ maxLenR) ∧ + kraftSum (k + 2) maxLenR wordR toksR < (k + 2) ^ maxLenR) ∧ + baseL.length ≤ 8 ∧ baseR.length ≤ 8 ∧ + ((∀ t : TokL, 2 ≤ (wordL t).length) ∨ (∀ t : TokR, 2 ≤ (wordR t).length)) ∧ + (∃ t : TokL, (0 : Fin (k + 2)) ∈ wordL t ∧ ∃ a, a ∈ wordL t ∧ a ≠ 0) ∧ + (∃ t : TokR, (0 : Fin (k + 2)) ∈ wordR t ∧ ∃ a, a ∈ wordR t ∧ a ≠ 0) ∧ + encLeft [] = ListBlank.append baseL default ∧ + (∀ t L, encLeft (t :: L) = ListBlank.append (wordL t) (encLeft L)) ∧ + encRight [] = ListBlank.append baseR default ∧ + (∀ t R, encRight (t :: R) = ListBlank.append (wordR t) (encRight R)) ∧ + (∃ t : ListBlank (Fin (k + 2)), ∀ L : List TokL, encLeft L ≠ t) ∧ + (∃ t : ListBlank (Fin (k + 2)), ∀ R : List TokR, encRight R ≠ t) ∧ + IsValidTransducerModes encLeft encRight evalTransducerCfg ∧ + (∀ cfg, IsInTransducerSystem cfg ↔ ∃ m L R, cfg = evalTransducerCfg m L R) ∧ + (∀ m L R m' L' R', + stepMacro m L R = some (m', L', R') → + ReachesPlus M (evalTransducerCfg m L R) (evalTransducerCfg m' L' R')) ∧ + ∃ (m₀ : TransducerMode) (L₀ : List TokL) (R₀ : List TokR), + L₀.length + R₀.length ≤ 4 ∧ + ReachesPlus M (init []) (evalTransducerCfg m₀ L₀ R₀) ∧ + (∃ (n_grow : ℕ) (m_g : TransducerMode) (L_g : List TokL) (R_g : List TokR), + 512 ≤ n_grow ∧ n_grow ≤ 2048 ∧ + iterTransducerMacro stepMacro n_grow (m₀, L₀, R₀) = some (m_g, L_g, R_g) ∧ + 20 ≤ L_g.length + R_g.length) ∧ + (∀ m : TransducerMode, ∃ (n_m : ℕ) (L_m : List TokL) (R_m : List TokR), + n_m ≤ 256 ∧ + iterTransducerMacro stepMacro n_m (m₀, L₀, R₀) = some (m, L_m, R_m)) ∧ + (∀ t : TokL, ∃ (n_t : ℕ) (m_t : TransducerMode) (L_t : List TokL) (R_t : List TokR), + n_t ≤ 256 ∧ + iterTransducerMacro stepMacro n_t (m₀, L₀, R₀) = some (m_t, L_t, R_t) ∧ + t ∈ L_t) ∧ + (∀ t : TokR, ∃ (n_t : ℕ) (m_t : TransducerMode) (L_t : List TokL) (R_t : List TokR), + n_t ≤ 256 ∧ + iterTransducerMacro stepMacro n_t (m₀, L₀, R₀) = some (m_t, L_t, R_t) ∧ + t ∈ R_t) ∧ + ((∃ (m_exit : TransducerMode) (tL_exit : TokL) (exitNext : List TokL), + exitNext.Nodup ∧ exitNext ≠ [] ∧ + (∀ R : List TokR, (stepMacro m_exit [tL_exit] R).isSome) ∧ + (∀ m L R, + stepMacro m L R = none ↔ + (m = m_exit ∧ ∃ t₂ L'', t₂ ∈ exitNext ∧ L = tL_exit :: t₂ :: L'')) ∧ + (∀ t₂ ∈ exitNext, ∀ R : List TokR, ∃ cfg_h, + ReachesPlus M (evalTransducerCfg m_exit [tL_exit, t₂] R) cfg_h ∧ + (step M cfg_h).isNone) ∧ + (∀ t₂ ∈ exitNext, ∃ sfx : List TokL, sfx.length ≤ 2 ∧ + ∀ (L'' : List TokL) (R : List TokR), ∃ cfg_h, + ReachesPlus M (evalTransducerCfg m_exit (tL_exit :: t₂ :: (sfx ++ L'')) R) cfg_h ∧ + (step M cfg_h).isNone)) ∨ + (∃ (m_exit : TransducerMode) (tR_exit : TokR) (exitNext : List TokR), + exitNext.Nodup ∧ exitNext ≠ [] ∧ + (∀ L : List TokL, (stepMacro m_exit L [tR_exit]).isSome) ∧ + (∀ m L R, + stepMacro m L R = none ↔ + (m = m_exit ∧ ∃ t₂ R'', t₂ ∈ exitNext ∧ R = tR_exit :: t₂ :: R'')) ∧ + (∀ t₂ ∈ exitNext, ∀ L : List TokL, ∃ cfg_h, + ReachesPlus M (evalTransducerCfg m_exit L [tR_exit, t₂]) cfg_h ∧ + (step M cfg_h).isNone) ∧ + (∀ t₂ ∈ exitNext, ∃ sfx : List TokR, sfx.length ≤ 2 ∧ + ∀ (L : List TokL) (R'' : List TokR), ∃ cfg_h, + ReachesPlus M (evalTransducerCfg m_exit L (tR_exit :: t₂ :: (sfx ++ R''))) cfg_h ∧ + (step M cfg_h).isNone))) ∧ + (∃ (m_lr m_rl : TransducerMode) (tL tL' : TokL) (tR tR' : TokR) (s₁ s₂ s₃ s₄ : ℕ), + 1 ≤ s₁ ∧ s₁ ≤ 4 ∧ 1 ≤ s₂ ∧ s₂ ≤ 4 ∧ + 1 ≤ s₃ ∧ s₃ ≤ 4 ∧ 1 ≤ s₄ ∧ s₄ ≤ 4 ∧ + 2 ≤ (wordL tL).length ∧ 2 ≤ (wordR tR).length ∧ + 2 ≤ (wordL tL').length ∧ 2 ≤ (wordR tR').length ∧ + (((wordL tL) ^ s₁).reverse ≠ (wordR tR) ^ s₂ ∨ + ((wordR tR') ^ s₃).reverse ≠ (wordL tL') ^ s₄) ∧ + (wordL tL ≠ wordL tL' ∨ wordR tR ≠ wordR tR' ∨ s₁ ≠ s₂ ∨ s₃ ≠ s₄) ∧ + (∃ (n_lr : ℕ) (L_lr : List TokL) (R_lr : List TokR), + n_lr ≤ 256 ∧ + iterTransducerMacro stepMacro n_lr (m₀, L₀, R₀) = some (m_lr, L_lr, R_lr) ∧ + L_lr.take (2 * s₁) = List.replicate (2 * s₁) tL) ∧ + (∃ (n_rl : ℕ) (L_rl : List TokL) (R_rl : List TokR), + n_rl ≤ 256 ∧ + iterTransducerMacro stepMacro n_rl (m₀, L₀, R₀) = some (m_rl, L_rl, R_rl) ∧ + R_rl.take (2 * s₃) = List.replicate (2 * s₃) tR') ∧ + (∀ (n : ℕ) (L : List TokL) (R : List TokR), + ReachesPlus M + (evalTransducerCfg m_lr (List.replicate (s₁ * (n + 1)) tL ++ L) R) + (evalTransducerCfg m_lr L (List.replicate (s₂ * (n + 1)) tR ++ R))) ∧ + (∀ (n : ℕ) (L : List TokL) (R : List TokR), + ReachesPlus M + (evalTransducerCfg m_rl L (List.replicate (s₃ * (n + 1)) tR' ++ R)) + (evalTransducerCfg m_rl (List.replicate (s₄ * (n + 1)) tL' ++ L) R))) + +end BusyBeaver diff --git a/BusyBeaverChallenge.lean b/BusyBeaverChallenge.lean index 3dd18431..20ad83da 100644 --- a/BusyBeaverChallenge.lean +++ b/BusyBeaverChallenge.lean @@ -172,6 +172,21 @@ def IsNotHalt (M : Machine Γ Λ) : Prop := /-- Alias for `IsNotHalt`. -/ abbrev IsDoesNotHalt (M : Machine Γ Λ) : Prop := IsNotHalt M +/-- Atomic `NeZero (k + 2)` instance for alphabet size `Fin (k + 2)`. +Ensures `HasStackReduction` and `HasOdometerReduction` synthesize an atomic constant +rather than composite proof `instNeZeroNatHAdd_1 k 2`, avoiding per-module `_proof_1` +auxiliary definitions that break cross-module AST equality in the comparator. +Priority `default + 1` is required because at default priority Lean prioritizes +Mathlib's composite `instNeZeroNatHAdd_1`. -/ +instance (priority := default + 1) instNeZeroK2 (k : ℕ) : @NeZero ℕ Zero.ofOfNat0 (k + 2) := + ⟨Nat.succ_ne_zero (k + 1)⟩ + +/-- Atomic `NeZero 2` instance with higher priority than `instNeZeroK2`. +Ensures literal `Fin 2` does not match `instNeZeroK2 0`, which would embed a dependency +on `0` into the typeclass instance and break `generalize 0 = n` in downstream proofs. -/ +instance (priority := default + 2) instNeZeroTwoLit : @NeZero ℕ Zero.ofOfNat0 2 := + ⟨Nat.succ_ne_zero 1⟩ + /-- Parametric regular-expression half-tape expressions for `HasCollatzReduction`. -/ inductive TapeExpr (Γ : Type*) where | default : TapeExpr Γ From 1ace61729ca420a671fdc2e443ffbe368d42f778 Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Fri, 6 Nov 2026 19:07:50 +0000 Subject: [PATCH 2/7] Add google3 predicates WordRun, Segmented, and IsCryptid with autoImplicit=false --- ...LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean | 2 +- BusyBeaver/Basic.lean | 2 + BusyBeaver/Defs.lean | 7 + BusyBeaver/Defs/Patterns.lean | 14 + BusyBeaver/Defs/Segmented.lean | 102 ++++++ BusyBeaver/Defs/WordRun.lean | 340 ++++++++++++++++++ lakefile.toml | 1 + 7 files changed, 467 insertions(+), 1 deletion(-) create mode 100644 BusyBeaver/Defs/Segmented.lean create mode 100644 BusyBeaver/Defs/WordRun.lean diff --git a/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean b/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean index ac2171f7..687c1692 100644 --- a/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean +++ b/BusyBeaver/BB6/M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH.lean @@ -51,7 +51,7 @@ def wOf : ℕ → List (Fin 2) := def familyCfg (k : ℕ) : Cfg (Fin 2) (Fin 6) := evalAffCfg qOf wOf k initReturnCfg -private def repList (n : ℕ) (xs : List α) : List α := +private def repList {α : Type*} (n : ℕ) (xs : List α) : List α := match n with | 0 => [] | n + 1 => xs ++ repList n xs diff --git a/BusyBeaver/Basic.lean b/BusyBeaver/Basic.lean index e2266e2b..93e9c470 100644 --- a/BusyBeaver/Basic.lean +++ b/BusyBeaver/Basic.lean @@ -1025,6 +1025,8 @@ private theorem iterate_bind_none {S : Type*} (next : S → Option S) (n : ℕ) | succ n ih => rw [Function.iterate_succ_apply, Option.bind_none, ih] +variable {S : Type*} + private theorem CollatzReachesIn.head {next : S → Option S} {n : ℕ} {s₁ s₂ s₃ : S} (h₁ : next s₁ = some s₂) (h₂ : CollatzReachesIn next n s₂ s₃) : CollatzReachesIn next (n + 1) s₁ s₃ := by diff --git a/BusyBeaver/Defs.lean b/BusyBeaver/Defs.lean index 49ade9c8..c7b67461 100644 --- a/BusyBeaver/Defs.lean +++ b/BusyBeaver/Defs.lean @@ -9,6 +9,8 @@ public import BusyBeaver.Defs.Patterns public import BusyBeaver.Defs.Stack public import BusyBeaver.Defs.Odometer public import BusyBeaver.Defs.Transducer +public import BusyBeaver.Defs.WordRun +public import BusyBeaver.Defs.Segmented /-! # Busy Beaver Holdout Definitions (`BusyBeaver.Defs`) @@ -24,6 +26,7 @@ goal predicates for Busy Beaver holdouts. - `BusyBeaver.Defs.Patterns`: - `HasCollatzReduction` — `M` is governed by a closed accelerated regular-expression tape pattern set. + - `IsCryptid` — `M` is governed by a compact (length ≤ 16) closed accelerated tape pattern set. - `BusyBeaver.Defs.Stack`: - `HasStackedCollatzReduction` — `M` is governed by a closed accelerated stack-word tape pattern set. @@ -32,4 +35,8 @@ goal predicates for Busy Beaver holdouts. - `HasOdometerReduction` — `M` is governed by a closed mixed-radix odometer-word hub. - `BusyBeaver.Defs.Transducer`: - `HasTransducerReduction` — `M` is governed by a closed bidirectional word-stack transducer. +- `BusyBeaver.Defs.WordRun`: + - `IsWordRunCryptid` — `M` is governed by a closed invariant-relative word-run stack system. +- `BusyBeaver.Defs.Segmented`: + - `IsSegmentedCryptid` — `M` is governed by a unifying ≤ 3-region segmented tape schema. -/ diff --git a/BusyBeaver/Defs/Patterns.lean b/BusyBeaver/Defs/Patterns.lean index cba6e771..31457c97 100644 --- a/BusyBeaver/Defs/Patterns.lean +++ b/BusyBeaver/Defs/Patterns.lean @@ -110,6 +110,20 @@ member configuration steps in `ReachesPlus` either to another member or to a hal def HasCollatzReduction (M : Machine Γ Λ) : Prop := ∃ ps : TapePatternSet Γ Λ, IsClosedPatternSet M ps +/-- +Trusted Definition (`IsCryptid`): +The long-term behavior of `M` is governed by a compact closed accelerated pattern set `ps` +(`ps.length ≤ 16`) containing a reachable initial configuration, where every pattern in `ps` +transitions in `ReachesPlus` (`n ≥ 1` steps) to another pattern in `ps` or to a halting state. +-/ +def IsCryptid (M : Machine Γ Λ) : Prop := + ∃ (ps : TapePatternSet Γ Λ), + ps.length ≤ 16 ∧ + (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInPatternSet ps cfg₀) ∧ + (∀ cfg, IsInPatternSet ps cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ + (IsInPatternSet ps cfg' ∨ (step M cfg').isNone)) + /-- An abstract partial transition system `next : S → Option S` halts from `s₀ : S` if iterating `next` from `some s₀` eventually produces `none`. -/ def CollatzHalts {S : Type*} (next : S → Option S) (s₀ : S) : Prop := diff --git a/BusyBeaver/Defs/Segmented.lean b/BusyBeaver/Defs/Segmented.lean new file mode 100644 index 00000000..e0e97556 --- /dev/null +++ b/BusyBeaver/Defs/Segmented.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Mathlib.Computability.TuringMachine.PostTuringMachine +public import Mathlib.Data.List.Basic +public import Mathlib.Data.Nat.Basic +public import BusyBeaver.Defs.Core +public import BusyBeaver.Defs.Stack +public import BusyBeaver.Defs.WordRun + +/-! +# Segmented Tape Definitions (`BusyBeaver.Defs.Segmented`) + +Segmented schema (`IsSegmentedCryptid`) and supporting definitions for partitioned half-tapes +composed of register, word-run, finite-word, and gadget regions. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +/-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ +inductive SegRegionKind (Γ : Type*) where + | reg (blk : List Γ) (val : ℕ) + | wordRun (frames : List (List Γ × ℕ)) + | finWord (words : List (List Γ)) + | gadget (w : List Γ) + +/-- Evaluates a single `SegRegionKind Γ` into its `List Γ` bit-segment. -/ +def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ + | .reg blk v => blk ^ v + | .wordRun [] => [] + | .wordRun ((w, m) :: rest) => (w ^ m) ++ evalSegRegion (.wordRun rest) + | .finWord [] => [] + | .finWord (w :: ws) => w ++ evalSegRegion (.finWord ws) + | .gadget w => w + +/-- Evaluates a `≤ 3`-region segmented half-tape `List (SegRegionKind Γ)` onto `default`. -/ +def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ + | [] => default + | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) + +/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the + valid states): every finite window of every valid half-tape extends to a half-tape that no + valid state encodes, i.e. the image has empty interior in the prefix topology. A + bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family + certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ +def IsNowhereDenseFamily {Γ S : Type*} [Inhabited Γ] + (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := + ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, + (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad + +/-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ +def IsNowhereDenseHalf {Γ S : Type*} [Inhabited Γ] + (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := + IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) + +/-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must + be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view + prefix). -/ +def IsSegmentedCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (SegState : Type) + (Mode : Type) + (ValidSeg : SegState → Prop) + (modeOf : SegState → Mode) + (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) + (evalCfg : SegState → Cfg (Fin (k + 2)) Λ), + (∃ modes : List Mode, 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ + (∀ s, ValidSeg s → (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s))))) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ + (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ + (IsNowhereDenseHalf ValidSeg segsR ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ + (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ + (∀ s, ValidSeg s → + ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + +end BusyBeaver diff --git a/BusyBeaver/Defs/WordRun.lean b/BusyBeaver/Defs/WordRun.lean new file mode 100644 index 00000000..71895b9c --- /dev/null +++ b/BusyBeaver/Defs/WordRun.lean @@ -0,0 +1,340 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Mathlib.Computability.TuringMachine.PostTuringMachine +public import Mathlib.Data.List.Basic +public import Mathlib.Data.Nat.Basic +public import BusyBeaver.Defs.Core +public import BusyBeaver.Defs.Stack + +/-! +# Word-Run Stack Definitions (`BusyBeaver.Defs.WordRun`) + +Closed invariant-relative word-run stack cryptid (`IsWordRunCryptid`) and supporting definitions +for parameterized word stacks with accumulator registers. +-/ + +@[expose] public section + +namespace BusyBeaver + +open Relation Turing + +/-- Specification for one half-tape of a word-run stack with `numRegs` (`≤ 2`) bottom + accumulator registers. -/ +structure WordStackSpec (Γ Tok : Type*) (numRegs : ℕ) where + word : Tok → List Γ + stride : Tok → ℕ + offset : Tok → ℕ + base : List Γ + regWord : Fin numRegs → List Γ + +/-- Encodes `m` accumulator registers `(rw 0 ^ r 0) +> ... +> tail`. -/ +def encRegsAux {Γ : Type*} [Inhabited Γ] : + (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ListBlank Γ → ListBlank Γ + | 0, _, _, tail => tail + | m + 1, rw, r, tail => + ListBlank.append ((rw 0) ^ (r 0)) (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) + +/-- Encodes the bottom accumulator registers + `base` of a `WordStackSpec`. -/ +def encRegs {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (regs : Fin numRegs → ℕ) : ListBlank Γ := + encRegsAux numRegs spec.regWord regs (ListBlank.append spec.base default) + +/-- Encodes a word-run stack `List (Tok × ℕ)` on top of `encRegs spec regs`: + `encHalf spec regs ((t, d) :: rest) = + ListBlank.append ((word t)^(stride t * d + offset t)) (encHalf spec regs rest)`. -/ +def encHalf {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (regs : Fin numRegs → ℕ) : + List (Tok × ℕ) → ListBlank Γ + | [] => encRegs spec regs + | (t, d) :: rest => + ListBlank.append ((spec.word t) ^ (spec.stride t * d + spec.offset t)) + (encHalf spec regs rest) + +/-- Exact encoded symbol length of a single word-run frame `(t, d)`. -/ +def frameBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (f : Tok × ℕ) : ℕ := + (spec.word f.1).length * (spec.stride f.1 * f.2 + spec.offset f.1) + +/-- Encoded symbol length of the active top frame (`0` on empty stack `[]`). -/ +def topFrameBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → ℕ + | [] => 0 + | f :: _ => frameBitLen spec f + +/-- Total encoded symbol length across all frames of `xs`. -/ +def stackBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → ℕ + | [] => 0 + | f :: rest => frameBitLen spec f + stackBitLen spec rest + +/-- Total encoded symbol length of the bottom accumulator registers. -/ +def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ℕ + | 0, _, _ => 0 + | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) + +/-- Prefix length of a `HalfTapeView`. -/ +def viewPrefixLen {Γ : Type*} : HalfTapeView Γ → ℕ + | .id p => p.length + | .tail p => p.length + +/-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ +structure WordSysState (Mode TokL TokR : Type*) (numRegsL numRegsR : ℕ) where + mode : Mode + regsL : Fin numRegsL → ℕ + regsR : Fin numRegsR → ℕ + L : List (TokL × ℕ) + R : List (TokR × ℕ) + +/-- Total active bit-length of both stacks and registers in `s`. -/ +def totalSystemBitLen {Γ Mode TokL TokR : Type*} {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (s : WordSysState Mode TokL TokR numRegsL numRegsR) : ℕ := + stackBitLen specL s.L + stackBitLen specR s.R + + regsBitLenAux numRegsL specL.regWord s.regsL + + regsBitLenAux numRegsR specR.regWord s.regsR + +/-- Every `Mode` evaluates `s` as a fixed control state `q` and bounded `HalfTapeView`s + (`≤ 8`-symbol prefixes) of `encHalf specL s.regsL s.L` and `encHalf specR s.regsR s.R`. -/ +def IsValidWordModes {Γ Λ Mode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] + {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg Γ Λ) : Prop := + ∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), + viewPrefixLen vL ≤ 8 ∧ + viewPrefixLen vR ≤ 8 ∧ + ((∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), applyView vL (encHalf specL rL L), + applyView vR (encHalf specR rR R)⟩⟩) ∨ + (∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (applyView vL (encHalf specL rL L)) (applyView vR (encHalf specR rR R))) ∨ + (∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (applyView vL (encHalf specL rL L)) (applyView vR (encHalf specR rR R)))) + +/-- Iterates a partial macro-transition `stepMacro : S → Option S` for `k` macro-steps. -/ +def iterWordMacro {S : Type*} (stepMacro : S → Option S) : ℕ → S → Option S + | 0, s => some s + | k + 1, s => + match stepMacro s with + | none => none + | some s' => iterWordMacro stepMacro k s' + +/-- `PreservesOrGrows spec xs xs'` holds when `xs` is NOT net-drained above a shared suffix `rest`: + `xs = u ++ rest` and `xs' = pfx ++ rest` with `stackBitLen spec u ≤ stackBitLen spec pfx`. -/ +def PreservesOrGrows {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ∃ u pfx rest, + xs = u ++ rest ∧ + xs' = pfx ++ rest ∧ + stackBitLen spec u ≤ stackBitLen spec pfx + +/-- `DrainsTop spec xs xs'` holds whenever the transition `xs ↦ xs'` net-drains encoded bits + from the stack (`¬ PreservesOrGrows spec xs xs'`). -/ +def DrainsTop {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ¬ PreservesOrGrows spec xs xs' + +/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is completely popped. -/ +def PopsTop {Tok : Type*} (xs xs' : List (Tok × ℕ)) : Prop := + ∃ f, xs = f :: xs' + +/-- `DrainsTopFrame spec xs xs'` holds when the active top frame `f` of `xs = f :: rest` + is popped or replaced by at most an `8`-bit remainder prefix `pfx` (`xs' = pfx ++ rest`). -/ +def DrainsTopFrame {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ∃ f pfx rest, + xs = f :: rest ∧ + xs' = pfx ++ rest ∧ + stackBitLen spec pfx ≤ 8 + +/-- Strict frame-length progress law over `WordSysState`. -/ +def StrictFrameProgress {Γ Mode TokL TokR : Type*} {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (s s' : WordSysState Mode TokL TokR numRegsL numRegsR) (n : ℕ) : Prop := + 1 ≤ n ∧ + (DrainsTop specL s.L s'.L → 2 ≤ topFrameBitLen specL s.L → 2 ≤ n) ∧ + (DrainsTop specR s.R s'.R → 2 ≤ topFrameBitLen specR s.R → 2 ≤ n) ∧ + (PopsTop s.L s'.L → topFrameBitLen specL s.L ≤ n) ∧ + (PopsTop s.R s'.R → topFrameBitLen specR s.R ≤ n) + +/-- Side selector (`leftSide` vs `rightSide`) for orbit-exercised run-drain witnesses. -/ +inductive StackSide + | leftSide + | rightSide + +/-- Every pair of adjacent frames on the stack has distinct token constructors (`t₁ ≠ t₂`). -/ +def AdjacentDistinctTok {Tok : Type*} : List (Tok × ℕ) → Prop + | [] => True + | [_] => True + | (t₁, _) :: (t₂, d₂) :: rest => t₁ ≠ t₂ ∧ AdjacentDistinctTok ((t₂, d₂) :: rest) + +/-- Canonical merged word-run frame discipline. -/ +def MergedRunFrames {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → Prop + | [] => True + | [(t, d)] => spec.stride t = 0 → d = 0 + | (t₁, d₁) :: (t₂, d₂) :: rest => + (spec.stride t₁ = 0 → d₁ = 0) ∧ + (1 ≤ spec.stride t₁ → t₁ ≠ t₂) ∧ + MergedRunFrames spec ((t₂, d₂) :: rest) + +/-- Non-blank bottom-anchor discipline. -/ +def AnchoredFrames {k numRegs : ℕ} {Tok : Type*} + (spec : WordStackSpec (Fin (k + 2)) Tok numRegs) : List (Tok × ℕ) → Prop + | [] => True + | [(t, _)] => (∃ x ∈ spec.word t, x ≠ 0) ∨ (∃ x ∈ spec.base, x ≠ 0) + | _ :: f₂ :: rest => AnchoredFrames spec (f₂ :: rest) + +/-- Boundary-aligned H4 run-pair side discipline when `encHalf` is universal (`kraftSum = B^M`). -/ +def IsBoundaryAlignedSide {Γ Λ Mode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] + {numRegsL numRegsR : ℕ} + (side : StackSide) + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (ValidState : WordSysState Mode TokL TokR numRegsL numRegsR → Prop) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg Γ Λ) : Prop := + match side with + | .leftSide => + numRegsL = 0 ∧ + specL.base = [] ∧ + (∀ t : TokL, (specL.word t).length = 1 ∧ specL.stride t = 1 ∧ specL.offset t = 1) ∧ + (∀ s, ValidState s → AdjacentDistinctTok s.L) ∧ + (∀ m : Mode, ∃ (q : Λ) (vR : HalfTapeView Γ), + viewPrefixLen vR ≤ 8 ∧ + ((∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), encHalf specL rL L, applyView vR (encHalf specR rR R)⟩⟩) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (encHalf specL rL L) (applyView vR (encHalf specR rR R))) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (encHalf specL rL L) (applyView vR (encHalf specR rR R))))) + | .rightSide => + numRegsR = 0 ∧ + specR.base = [] ∧ + (∀ t : TokR, (specR.word t).length = 1 ∧ specR.stride t = 1 ∧ specR.offset t = 1) ∧ + (∀ s, ValidState s → AdjacentDistinctTok s.R) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL : HalfTapeView Γ), + viewPrefixLen vL ≤ 8 ∧ + ((∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), applyView vL (encHalf specL rL L), encHalf specR rR R⟩⟩) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (applyView vL (encHalf specL rL L)) (encHalf specR rR R)) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (applyView vL (encHalf specL rL L)) (encHalf specR rR R)))) + +/-- Closed Invariant-Relative Word-Run Stack Cryptid (`IsWordRunCryptid`). -/ +def IsWordRunCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (Mode TokL TokR : Type) + (numRegsL numRegsR : ℕ) + (specL : WordStackSpec (Fin (k + 2)) TokL numRegsL) + (specR : WordStackSpec (Fin (k + 2)) TokR numRegsR) + (ValidState : WordSysState Mode TokL TokR numRegsL numRegsR → Prop) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg (Fin (k + 2)) Λ) + (stepMacro : WordSysState Mode TokL TokR numRegsL numRegsR → + Option (WordSysState Mode TokL TokR numRegsL numRegsR)), + numRegsL ≤ 2 ∧ numRegsR ≤ 2 ∧ + specL.base.length ≤ 8 ∧ specR.base.length ≤ 8 ∧ + Function.Injective specL.word ∧ Function.Injective specR.word ∧ + (∀ i : Fin numRegsL, 1 ≤ (specL.regWord i).length ∧ (specL.regWord i).length ≤ 8 ∧ + (∃ x ∈ specL.regWord i, x ≠ 0)) ∧ + (∀ i : Fin numRegsR, 1 ≤ (specR.regWord i).length ∧ (specR.regWord i).length ≤ 8 ∧ + (∃ x ∈ specR.regWord i, x ≠ 0)) ∧ + (∃ modes : List Mode, + modes.Nodup ∧ 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ + (∃ (toksL : List TokL) (toksR : List TokR), + toksL.Nodup ∧ toksR.Nodup ∧ + 1 ≤ toksL.length ∧ toksL.length ≤ 8 ∧ + 1 ≤ toksR.length ∧ toksR.length ≤ 8 ∧ + 3 ≤ toksL.length + toksR.length ∧ + (∀ t : TokL, t ∈ toksL ∧ 1 ≤ (specL.word t).length ∧ (specL.word t).length ≤ 8 ∧ + 1 ≤ specL.offset t ∧ specL.stride t ≤ 8 ∧ specL.offset t ≤ 2 ∧ + (specL.stride t = 0 → specL.offset t = 1) ∧ + (1 ≤ specL.stride t → ∃ x ∈ specL.word t, x ≠ 0)) ∧ + (∀ t : TokR, t ∈ toksR ∧ 1 ≤ (specR.word t).length ∧ (specR.word t).length ≤ 8 ∧ + 1 ≤ specR.offset t ∧ specR.stride t ≤ 8 ∧ specR.offset t ≤ 2 ∧ + (specR.stride t = 0 → specR.offset t = 1) ∧ + (1 ≤ specR.stride t → ∃ x ∈ specR.word t, x ≠ 0))) ∧ + IsValidWordModes specL specR evalCfg ∧ + (∀ s, ValidState s → + MergedRunFrames specL s.L ∧ MergedRunFrames specR s.R ∧ + AnchoredFrames specL s.L ∧ AnchoredFrames specR s.R) ∧ + ((∃ badL : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specL s.regsL s.L ≠ badL) ∨ + IsBoundaryAlignedSide .leftSide specL specR ValidState evalCfg) ∧ + ((∃ badR : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specR s.regsR s.R ≠ badR) ∨ + IsBoundaryAlignedSide .rightSide specL specR ValidState evalCfg) ∧ + (∀ s s', ValidState s → stepMacro s = some s' → + ValidState s' ∧ ∃ n, StrictFrameProgress specL specR s s' n ∧ + ReachesIn M n (evalCfg s) (evalCfg s')) ∧ + (∀ s, ValidState s → stepMacro s = none → + ∃ (n_h : ℕ) (cfg_h : Cfg (Fin (k + 2)) Λ), + 1 ≤ n_h ∧ n_h ≤ 32 ∧ ReachesIn M n_h (evalCfg s) cfg_h ∧ (step M cfg_h).isNone) ∧ + (∃ s_depth : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR, + ∀ D : ℕ, ValidState (s_depth D) ∧ D ≤ (s_depth D).L.length + (s_depth D).R.length) ∧ + ∃ s₀ : WordSysState Mode TokL TokR numRegsL numRegsR, + ValidState s₀ ∧ + s₀.L.length + s₀.R.length ≤ 4 ∧ + ReachesPlus M (init []) (evalCfg s₀) ∧ + (∃ (n_grow1 n_grow2 : ℕ) (s_g1 s_g2 : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ n_grow1 ∧ n_grow1 < n_grow2 ∧ n_grow2 ≤ 2048 ∧ + iterWordMacro stepMacro n_grow1 s₀ = some s_g1 ∧ + iterWordMacro stepMacro n_grow2 s₀ = some s_g2 ∧ + 32 ≤ totalSystemBitLen specL specR s_g1 ∧ + totalSystemBitLen specL specR s_g1 + 32 ≤ totalSystemBitLen specL specR s_g2 ∧ + 2 ≤ s_g1.L.length + s_g1.R.length ∧ + 4 ≤ s_g1.L.length + s_g1.R.length + numRegsL + numRegsR) ∧ + (∃ (k_d1 k_d2 b₁ b₂ : ℕ) + (s_d1 s_d1' s_d2 s_d2' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_d1 ∧ k_d1 < k_d2 ∧ k_d2 ≤ 2048 ∧ + 26 ≤ b₁ ∧ b₁ < b₂ ∧ + iterWordMacro stepMacro k_d1 s₀ = some s_d1 ∧ stepMacro s_d1 = some s_d1' ∧ + iterWordMacro stepMacro k_d2 s₀ = some s_d2 ∧ stepMacro s_d2 = some s_d2' ∧ + ((s_d1'.regsL = s_d1.regsL ∧ PopsTop s_d1.L s_d1'.L ∧ b₁ = topFrameBitLen specL s_d1.L) ∨ + (s_d1'.regsR = s_d1.regsR ∧ PopsTop s_d1.R s_d1'.R ∧ b₁ = topFrameBitLen specR s_d1.R)) ∧ + ((s_d2'.regsL = s_d2.regsL ∧ PopsTop s_d2.L s_d2'.L ∧ b₂ = topFrameBitLen specL s_d2.L) ∨ + (s_d2'.regsR = s_d2.regsR ∧ PopsTop s_d2.R s_d2'.R ∧ b₂ = topFrameBitLen specR s_d2.R))) ∧ + (numRegsL = 0 → ∃ (k_L : ℕ) (s_L s_L' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_L ∧ k_L ≤ 2048 ∧ + iterWordMacro stepMacro k_L s₀ = some s_L ∧ stepMacro s_L = some s_L' ∧ + s_L'.regsL = s_L.regsL ∧ PopsTop s_L.L s_L'.L ∧ 18 ≤ topFrameBitLen specL s_L.L) ∧ + (numRegsR = 0 → ∃ (k_R : ℕ) (s_R s_R' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_R ∧ k_R ≤ 2048 ∧ + iterWordMacro stepMacro k_R s₀ = some s_R ∧ stepMacro s_R = some s_R' ∧ + s_R'.regsR = s_R.regsR ∧ PopsTop s_R.R s_R'.R ∧ 18 ≤ topFrameBitLen specR s_R.R) ∧ + (∀ i : Fin numRegsL, ∃ (n_reg : ℕ) (s_reg : WordSysState Mode TokL TokR numRegsL numRegsR), + n_reg ≤ 2048 ∧ iterWordMacro stepMacro n_reg s₀ = some s_reg ∧ 2 ≤ s_reg.regsL i) ∧ + (∀ i : Fin numRegsR, ∃ (n_reg : ℕ) (s_reg : WordSysState Mode TokL TokR numRegsL numRegsR), + n_reg ≤ 2048 ∧ iterWordMacro stepMacro n_reg s₀ = some s_reg ∧ 2 ≤ s_reg.regsR i) ∧ + (∀ m : Mode, ∃ (n_m : ℕ) (s_m : WordSysState Mode TokL TokR numRegsL numRegsR), + n_m ≤ 256 ∧ iterWordMacro stepMacro n_m s₀ = some s_m ∧ s_m.mode = m) ∧ + (∀ t : TokL, ∃ (n_t : ℕ) (s_t : WordSysState Mode TokL TokR numRegsL numRegsR) (d : ℕ), + n_t ≤ 2048 ∧ iterWordMacro stepMacro n_t s₀ = some s_t ∧ (t, d) ∈ s_t.L) ∧ + (∀ t : TokR, ∃ (n_t : ℕ) (s_t : WordSysState Mode TokL TokR numRegsL numRegsR) (d : ℕ), + n_t ≤ 2048 ∧ iterWordMacro stepMacro n_t s₀ = some s_t ∧ (t, d) ∈ s_t.R) ∧ + ((∃ (t_run : TokL) (s_fam : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR), + 1 ≤ specL.stride t_run ∧ + (∃ n_r s_r d_r, n_r ≤ 2048 ∧ iterWordMacro stepMacro n_r s₀ = some s_r ∧ + 1 ≤ d_r ∧ (t_run, d_r) ∈ s_r.L) ∧ + (∀ d : ℕ, ValidState (s_fam d) ∧ + (∃ d₀ rest, d ≤ d₀ ∧ (s_fam d).L = (t_run, d₀) :: rest) ∧ + (∃ s', stepMacro (s_fam d) = some s' ∧ PopsTop (s_fam d).L s'.L ∧ + topFrameBitLen specL (s_fam d).L ≤ totalSystemBitLen specL specR s' + 8))) ∨ + (∃ (t_run : TokR) (s_fam : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR), + 1 ≤ specR.stride t_run ∧ + (∃ n_r s_r d_r, n_r ≤ 2048 ∧ iterWordMacro stepMacro n_r s₀ = some s_r ∧ + 1 ≤ d_r ∧ (t_run, d_r) ∈ s_r.R) ∧ + (∀ d : ℕ, ValidState (s_fam d) ∧ + (∃ d₀ rest, d ≤ d₀ ∧ (s_fam d).R = (t_run, d₀) :: rest) ∧ + (∃ s', stepMacro (s_fam d) = some s' ∧ PopsTop (s_fam d).R s'.R ∧ + topFrameBitLen specR (s_fam d).R ≤ totalSystemBitLen specL specR s' + 8)))) + +end BusyBeaver diff --git a/lakefile.toml b/lakefile.toml index f078509b..fb974da0 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -28,6 +28,7 @@ name = "Challenge" [[lean_lib]] name = "BusyBeaver" +leanOptions = { autoImplicit = false } [[lean_lib]] name = "BusyBeaverChallenge" From d67ecd7fed43124690ec88b8c4fbd54247ac831d Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Fri, 6 Nov 2026 19:07:50 +0000 Subject: [PATCH 3/7] Add tools/render_challenge.py, CI synchronization check, and regenerate BusyBeaverChallenge.lean --- .github/workflows/busy_beaver_ci.yml | 4 + BusyBeaverChallenge.lean | 434 ++++++++++++++++++++++++++- tools/render_challenge.py | 167 +++++++++++ 3 files changed, 603 insertions(+), 2 deletions(-) create mode 100644 tools/render_challenge.py diff --git a/.github/workflows/busy_beaver_ci.yml b/.github/workflows/busy_beaver_ci.yml index 88a7a8ef..e065bfc3 100644 --- a/.github/workflows/busy_beaver_ci.yml +++ b/.github/workflows/busy_beaver_ci.yml @@ -13,6 +13,7 @@ on: - 'lakefile.toml' - 'lake-manifest.json' - 'lean-toolchain' + - 'tools/**' - '.github/workflows/busy_beaver_ci.yml' pull_request: paths: @@ -26,6 +27,7 @@ on: - 'lakefile.toml' - 'lake-manifest.json' - 'lean-toolchain' + - 'tools/**' - '.github/workflows/busy_beaver_ci.yml' workflow_dispatch: @@ -45,6 +47,8 @@ jobs: sudo sysctl -w kernel.apparmor_restrict_unprivileged_userns=0 - uses: actions/checkout@fbc6f3992d24b796d5a048ff273f7fcc4a7b6c09 # v5 + - name: Check BusyBeaverChallenge is synchronized with Defs + run: python3 tools/render_challenge.py --check - uses: leanprover/lean-action@fe408643ea7367d8c0404a8be3975bb145f5fb64 # v1.7.0 with: build-args: "BusyBeaver BusyBeaverChallenge" diff --git a/BusyBeaverChallenge.lean b/BusyBeaverChallenge.lean index 20ad83da..84ce6f60 100644 --- a/BusyBeaverChallenge.lean +++ b/BusyBeaverChallenge.lean @@ -120,11 +120,11 @@ structure Cfg (Γ Λ : Type*) [Inhabited Γ] where instance Cfg.inhabited : Inhabited (Cfg Γ Λ) := ⟨⟨default, default⟩⟩ /-- Configuration in state `q` with the tape head reading the first symbol of `r`. -/ -def Cfg.headRight {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := +@[reducible] def Cfg.headRight {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := ⟨some q, ⟨r.head, l, r.tail⟩⟩ /-- Configuration in state `q` with the tape head reading the first symbol of `l`. -/ -def Cfg.headLeft {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := +@[reducible] def Cfg.headLeft {Γ Λ : Type*} [Inhabited Γ] (q : Λ) (l r : ListBlank Γ) : Cfg Γ Λ := ⟨some q, ⟨l.head, l.tail, r⟩⟩ /-- Single-step execution semantics of a `BusyBeaver.Machine`. -/ @@ -153,6 +153,19 @@ def ReachesStar (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := def ReachesPlus (M : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) : Prop := ∃ n > 0, multiStep M c₁ n = some c₂ +scoped notation3 c₁ " [" M "]⊢ " c₂ => step M c₁ = some c₂ +scoped notation3 c₁ " [" M "]⊢^{" n "} " c₂ => multiStep M c₁ n = some c₂ +scoped notation3 c₁ " [" M "]⊢* " c₂ => ReachesStar M c₁ c₂ +scoped notation3 c₁ " [" M "]⊢⁺ " c₂ => ReachesPlus M c₁ c₂ + +scoped notation l " {{" s "}} " r => (⟨s, l, r⟩ : Tape _) +scoped notation:67 s:67 " << " a:68 => ListBlank.cons a s +scoped infixr:67 " >> " => ListBlank.cons +scoped notation:67 s:67 " <+ " l:68 => ListBlank.append l s +scoped infixr:67 " +> " => ListBlank.append +scoped notation3 l " {{" q "}}> " r => (⟨some q, ⟨ListBlank.head r, l, ListBlank.tail r⟩⟩ : Cfg _ _) +scoped notation3 l " <{{" q "}} " r => (⟨some q, ⟨ListBlank.head l, ListBlank.tail l, r⟩⟩ : Cfg _ _) + /-- Repeat finite list `l` `n` times (`l ^ n`). -/ instance instHPowListNat : HPow (List Γ) ℕ (List Γ) := ⟨fun l n => (List.replicate n l).flatten⟩ @@ -172,6 +185,8 @@ def IsNotHalt (M : Machine Γ Λ) : Prop := /-- Alias for `IsNotHalt`. -/ abbrev IsDoesNotHalt (M : Machine Γ Λ) : Prop := IsNotHalt M + + /-- Atomic `NeZero (k + 2)` instance for alphabet size `Fin (k + 2)`. Ensures `HasStackReduction` and `HasOdometerReduction` synthesize an atomic constant rather than composite proof `instNeZeroNatHAdd_1 k 2`, avoiding per-module `_proof_1` @@ -189,8 +204,11 @@ instance (priority := default + 2) instNeZeroTwoLit : @NeZero ℕ Zero.ofOfNat0 /-- Parametric regular-expression half-tape expressions for `HasCollatzReduction`. -/ inductive TapeExpr (Γ : Type*) where + /-- All-blank tail (`default : ListBlank Γ`). -/ | default : TapeExpr Γ + /-- Single symbol `a` followed by `rest`. -/ | sym (a : Γ) (rest : TapeExpr Γ) + /-- Finite block `blk` repeated `vars var_idx` times followed by `rest`. -/ | rep (blk : List Γ) (var_idx : ℕ) (rest : TapeExpr Γ) /-- Evaluate a `TapeExpr Γ` under variable assignment `vars : ℕ → ℕ`. -/ @@ -201,8 +219,11 @@ def evalTapeExpr {Γ : Type*} [Inhabited Γ] : TapeExpr Γ → (ℕ → ℕ) → /-- Parametric full-tape configuration pattern. -/ structure TapePattern (Γ Λ : Type*) where + /-- Left half-tape expression. -/ left : TapeExpr Γ + /-- Control state (`some q` or `none`). -/ head : Option Λ + /-- Right half-tape expression (whose head is under the tape head). -/ right : TapeExpr Γ /-- Evaluate a `TapePattern Γ Λ` under variable assignment `vars : ℕ → ℕ`. -/ @@ -213,11 +234,17 @@ def evalTapePattern {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] /-- Guard condition over `ℕ`-valued pattern variables. -/ inductive VarCond where + /-- `vars idx ≥ val`. -/ | ge_const (idx : ℕ) (val : ℕ) + /-- `vars idx1 ≥ vars idx2`. -/ | ge_var (idx1 idx2 : ℕ) + /-- Conjunction of conditions. -/ | and (c1 c2 : VarCond) + /-- Disjunction of conditions. -/ | or (c1 c2 : VarCond) + /-- Negation of a condition. -/ | not (c : VarCond) + /-- Trivially satisfied condition. -/ | true /-- Evaluate a `VarCond` under variable assignment `vars : ℕ → ℕ`. -/ @@ -252,6 +279,20 @@ member configuration steps in `ReachesPlus` either to another member or to a hal def HasCollatzReduction (M : Machine Γ Λ) : Prop := ∃ ps : TapePatternSet Γ Λ, IsClosedPatternSet M ps +/-- +Trusted Definition (`IsCryptid`): +The long-term behavior of `M` is governed by a compact closed accelerated pattern set `ps` +(`ps.length ≤ 16`) containing a reachable initial configuration, where every pattern in `ps` +transitions in `ReachesPlus` (`n ≥ 1` steps) to another pattern in `ps` or to a halting state. +-/ +def IsCryptid (M : Machine Γ Λ) : Prop := + ∃ (ps : TapePatternSet Γ Λ), + ps.length ≤ 16 ∧ + (∃ cfg₀, ReachesStar M (init []) cfg₀ ∧ IsInPatternSet ps cfg₀) ∧ + (∀ cfg, IsInPatternSet ps cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ + (IsInPatternSet ps cfg' ∨ (step M cfg').isNone)) + /-- An abstract partial transition system `next : S → Option S` halts from `s₀ : S` if iterating `next` from `some s₀` eventually produces `none`. -/ def CollatzHalts {S : Type*} (next : S → Option S) (s₀ : S) : Prop := @@ -742,6 +783,395 @@ def HasTransducerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] (evalTransducerCfg m_rl L (List.replicate (s₃ * (n + 1)) tR' ++ R)) (evalTransducerCfg m_rl (List.replicate (s₄ * (n + 1)) tL' ++ L) R))) +/-- Specification for one half-tape of a word-run stack with `numRegs` (`≤ 2`) bottom + accumulator registers. -/ +structure WordStackSpec (Γ Tok : Type*) (numRegs : ℕ) where + word : Tok → List Γ + stride : Tok → ℕ + offset : Tok → ℕ + base : List Γ + regWord : Fin numRegs → List Γ + +/-- Encodes `m` accumulator registers `(rw 0 ^ r 0) +> ... +> tail`. -/ +def encRegsAux {Γ : Type*} [Inhabited Γ] : + (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ListBlank Γ → ListBlank Γ + | 0, _, _, tail => tail + | m + 1, rw, r, tail => + ListBlank.append ((rw 0) ^ (r 0)) (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) + +/-- Encodes the bottom accumulator registers + `base` of a `WordStackSpec`. -/ +def encRegs {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (regs : Fin numRegs → ℕ) : ListBlank Γ := + encRegsAux numRegs spec.regWord regs (ListBlank.append spec.base default) + +/-- Encodes a word-run stack `List (Tok × ℕ)` on top of `encRegs spec regs`: + `encHalf spec regs ((t, d) :: rest) = + ListBlank.append ((word t)^(stride t * d + offset t)) (encHalf spec regs rest)`. -/ +def encHalf {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (regs : Fin numRegs → ℕ) : + List (Tok × ℕ) → ListBlank Γ + | [] => encRegs spec regs + | (t, d) :: rest => + ListBlank.append ((spec.word t) ^ (spec.stride t * d + spec.offset t)) + (encHalf spec regs rest) + +/-- Exact encoded symbol length of a single word-run frame `(t, d)`. -/ +def frameBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (f : Tok × ℕ) : ℕ := + (spec.word f.1).length * (spec.stride f.1 * f.2 + spec.offset f.1) + +/-- Encoded symbol length of the active top frame (`0` on empty stack `[]`). -/ +def topFrameBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → ℕ + | [] => 0 + | f :: _ => frameBitLen spec f + +/-- Total encoded symbol length across all frames of `xs`. -/ +def stackBitLen {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → ℕ + | [] => 0 + | f :: rest => frameBitLen spec f + stackBitLen spec rest + +/-- Total encoded symbol length of the bottom accumulator registers. -/ +def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ℕ + | 0, _, _ => 0 + | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) + +/-- Prefix length of a `HalfTapeView`. -/ +def viewPrefixLen {Γ : Type*} : HalfTapeView Γ → ℕ + | .id p => p.length + | .tail p => p.length + +/-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ +structure WordSysState (Mode TokL TokR : Type*) (numRegsL numRegsR : ℕ) where + mode : Mode + regsL : Fin numRegsL → ℕ + regsR : Fin numRegsR → ℕ + L : List (TokL × ℕ) + R : List (TokR × ℕ) + +/-- Total active bit-length of both stacks and registers in `s`. -/ +def totalSystemBitLen {Γ Mode TokL TokR : Type*} {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (s : WordSysState Mode TokL TokR numRegsL numRegsR) : ℕ := + stackBitLen specL s.L + stackBitLen specR s.R + + regsBitLenAux numRegsL specL.regWord s.regsL + + regsBitLenAux numRegsR specR.regWord s.regsR + +/-- Every `Mode` evaluates `s` as a fixed control state `q` and bounded `HalfTapeView`s + (`≤ 8`-symbol prefixes) of `encHalf specL s.regsL s.L` and `encHalf specR s.regsR s.R`. -/ +def IsValidWordModes {Γ Λ Mode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] + {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg Γ Λ) : Prop := + ∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView Γ), + viewPrefixLen vL ≤ 8 ∧ + viewPrefixLen vR ≤ 8 ∧ + ((∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), applyView vL (encHalf specL rL L), + applyView vR (encHalf specR rR R)⟩⟩) ∨ + (∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (applyView vL (encHalf specL rL L)) (applyView vR (encHalf specR rR R))) ∨ + (∀ rL rR L R, + evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (applyView vL (encHalf specL rL L)) (applyView vR (encHalf specR rR R)))) + +/-- Iterates a partial macro-transition `stepMacro : S → Option S` for `k` macro-steps. -/ +def iterWordMacro {S : Type*} (stepMacro : S → Option S) : ℕ → S → Option S + | 0, s => some s + | k + 1, s => + match stepMacro s with + | none => none + | some s' => iterWordMacro stepMacro k s' + +/-- `PreservesOrGrows spec xs xs'` holds when `xs` is NOT net-drained above a shared suffix `rest`: + `xs = u ++ rest` and `xs' = pfx ++ rest` with `stackBitLen spec u ≤ stackBitLen spec pfx`. -/ +def PreservesOrGrows {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ∃ u pfx rest, + xs = u ++ rest ∧ + xs' = pfx ++ rest ∧ + stackBitLen spec u ≤ stackBitLen spec pfx + +/-- `DrainsTop spec xs xs'` holds whenever the transition `xs ↦ xs'` net-drains encoded bits + from the stack (`¬ PreservesOrGrows spec xs xs'`). -/ +def DrainsTop {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ¬ PreservesOrGrows spec xs xs' + +/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is completely popped. -/ +def PopsTop {Tok : Type*} (xs xs' : List (Tok × ℕ)) : Prop := + ∃ f, xs = f :: xs' + +/-- `DrainsTopFrame spec xs xs'` holds when the active top frame `f` of `xs = f :: rest` + is popped or replaced by at most an `8`-bit remainder prefix `pfx` (`xs' = pfx ++ rest`). -/ +def DrainsTopFrame {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := + ∃ f pfx rest, + xs = f :: rest ∧ + xs' = pfx ++ rest ∧ + stackBitLen spec pfx ≤ 8 + +/-- Strict frame-length progress law over `WordSysState`. -/ +def StrictFrameProgress {Γ Mode TokL TokR : Type*} {numRegsL numRegsR : ℕ} + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (s s' : WordSysState Mode TokL TokR numRegsL numRegsR) (n : ℕ) : Prop := + 1 ≤ n ∧ + (DrainsTop specL s.L s'.L → 2 ≤ topFrameBitLen specL s.L → 2 ≤ n) ∧ + (DrainsTop specR s.R s'.R → 2 ≤ topFrameBitLen specR s.R → 2 ≤ n) ∧ + (PopsTop s.L s'.L → topFrameBitLen specL s.L ≤ n) ∧ + (PopsTop s.R s'.R → topFrameBitLen specR s.R ≤ n) + +/-- Side selector (`leftSide` vs `rightSide`) for orbit-exercised run-drain witnesses. -/ +inductive StackSide + | leftSide + | rightSide + +/-- Every pair of adjacent frames on the stack has distinct token constructors (`t₁ ≠ t₂`). -/ +def AdjacentDistinctTok {Tok : Type*} : List (Tok × ℕ) → Prop + | [] => True + | [_] => True + | (t₁, _) :: (t₂, d₂) :: rest => t₁ ≠ t₂ ∧ AdjacentDistinctTok ((t₂, d₂) :: rest) + +/-- Canonical merged word-run frame discipline. -/ +def MergedRunFrames {Γ Tok : Type*} {numRegs : ℕ} + (spec : WordStackSpec Γ Tok numRegs) : List (Tok × ℕ) → Prop + | [] => True + | [(t, d)] => spec.stride t = 0 → d = 0 + | (t₁, d₁) :: (t₂, d₂) :: rest => + (spec.stride t₁ = 0 → d₁ = 0) ∧ + (1 ≤ spec.stride t₁ → t₁ ≠ t₂) ∧ + MergedRunFrames spec ((t₂, d₂) :: rest) + +/-- Non-blank bottom-anchor discipline. -/ +def AnchoredFrames {k numRegs : ℕ} {Tok : Type*} + (spec : WordStackSpec (Fin (k + 2)) Tok numRegs) : List (Tok × ℕ) → Prop + | [] => True + | [(t, _)] => (∃ x ∈ spec.word t, x ≠ 0) ∨ (∃ x ∈ spec.base, x ≠ 0) + | _ :: f₂ :: rest => AnchoredFrames spec (f₂ :: rest) + +/-- Boundary-aligned H4 run-pair side discipline when `encHalf` is universal (`kraftSum = B^M`). -/ +def IsBoundaryAlignedSide {Γ Λ Mode TokL TokR : Type*} [Inhabited Γ] [OfNat Γ 0] + {numRegsL numRegsR : ℕ} + (side : StackSide) + (specL : WordStackSpec Γ TokL numRegsL) + (specR : WordStackSpec Γ TokR numRegsR) + (ValidState : WordSysState Mode TokL TokR numRegsL numRegsR → Prop) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg Γ Λ) : Prop := + match side with + | .leftSide => + numRegsL = 0 ∧ + specL.base = [] ∧ + (∀ t : TokL, (specL.word t).length = 1 ∧ specL.stride t = 1 ∧ specL.offset t = 1) ∧ + (∀ s, ValidState s → AdjacentDistinctTok s.L) ∧ + (∀ m : Mode, ∃ (q : Λ) (vR : HalfTapeView Γ), + viewPrefixLen vR ≤ 8 ∧ + ((∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), encHalf specL rL L, applyView vR (encHalf specR rR R)⟩⟩) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (encHalf specL rL L) (applyView vR (encHalf specR rR R))) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (encHalf specL rL L) (applyView vR (encHalf specR rR R))))) + | .rightSide => + numRegsR = 0 ∧ + specR.base = [] ∧ + (∀ t : TokR, (specR.word t).length = 1 ∧ specR.stride t = 1 ∧ specR.offset t = 1) ∧ + (∀ s, ValidState s → AdjacentDistinctTok s.R) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL : HalfTapeView Γ), + viewPrefixLen vL ≤ 8 ∧ + ((∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + ⟨some q, ⟨(0 : Γ), applyView vL (encHalf specL rL L), encHalf specR rR R⟩⟩) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headLeft q (applyView vL (encHalf specL rL L)) (encHalf specR rR R)) ∨ + (∀ rL rR L R, evalCfg ⟨m, rL, rR, L, R⟩ = + Cfg.headRight q (applyView vL (encHalf specL rL L)) (encHalf specR rR R)))) + +/-- Closed Invariant-Relative Word-Run Stack Cryptid (`IsWordRunCryptid`). -/ +def IsWordRunCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (Mode TokL TokR : Type) + (numRegsL numRegsR : ℕ) + (specL : WordStackSpec (Fin (k + 2)) TokL numRegsL) + (specR : WordStackSpec (Fin (k + 2)) TokR numRegsR) + (ValidState : WordSysState Mode TokL TokR numRegsL numRegsR → Prop) + (evalCfg : WordSysState Mode TokL TokR numRegsL numRegsR → Cfg (Fin (k + 2)) Λ) + (stepMacro : WordSysState Mode TokL TokR numRegsL numRegsR → + Option (WordSysState Mode TokL TokR numRegsL numRegsR)), + numRegsL ≤ 2 ∧ numRegsR ≤ 2 ∧ + specL.base.length ≤ 8 ∧ specR.base.length ≤ 8 ∧ + Function.Injective specL.word ∧ Function.Injective specR.word ∧ + (∀ i : Fin numRegsL, 1 ≤ (specL.regWord i).length ∧ (specL.regWord i).length ≤ 8 ∧ + (∃ x ∈ specL.regWord i, x ≠ 0)) ∧ + (∀ i : Fin numRegsR, 1 ≤ (specR.regWord i).length ∧ (specR.regWord i).length ≤ 8 ∧ + (∃ x ∈ specR.regWord i, x ≠ 0)) ∧ + (∃ modes : List Mode, + modes.Nodup ∧ 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ + (∃ (toksL : List TokL) (toksR : List TokR), + toksL.Nodup ∧ toksR.Nodup ∧ + 1 ≤ toksL.length ∧ toksL.length ≤ 8 ∧ + 1 ≤ toksR.length ∧ toksR.length ≤ 8 ∧ + 3 ≤ toksL.length + toksR.length ∧ + (∀ t : TokL, t ∈ toksL ∧ 1 ≤ (specL.word t).length ∧ (specL.word t).length ≤ 8 ∧ + 1 ≤ specL.offset t ∧ specL.stride t ≤ 8 ∧ specL.offset t ≤ 2 ∧ + (specL.stride t = 0 → specL.offset t = 1) ∧ + (1 ≤ specL.stride t → ∃ x ∈ specL.word t, x ≠ 0)) ∧ + (∀ t : TokR, t ∈ toksR ∧ 1 ≤ (specR.word t).length ∧ (specR.word t).length ≤ 8 ∧ + 1 ≤ specR.offset t ∧ specR.stride t ≤ 8 ∧ specR.offset t ≤ 2 ∧ + (specR.stride t = 0 → specR.offset t = 1) ∧ + (1 ≤ specR.stride t → ∃ x ∈ specR.word t, x ≠ 0))) ∧ + IsValidWordModes specL specR evalCfg ∧ + (∀ s, ValidState s → + MergedRunFrames specL s.L ∧ MergedRunFrames specR s.R ∧ + AnchoredFrames specL s.L ∧ AnchoredFrames specR s.R) ∧ + ((∃ badL : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specL s.regsL s.L ≠ badL) ∨ + IsBoundaryAlignedSide .leftSide specL specR ValidState evalCfg) ∧ + ((∃ badR : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specR s.regsR s.R ≠ badR) ∨ + IsBoundaryAlignedSide .rightSide specL specR ValidState evalCfg) ∧ + (∀ s s', ValidState s → stepMacro s = some s' → + ValidState s' ∧ ∃ n, StrictFrameProgress specL specR s s' n ∧ + ReachesIn M n (evalCfg s) (evalCfg s')) ∧ + (∀ s, ValidState s → stepMacro s = none → + ∃ (n_h : ℕ) (cfg_h : Cfg (Fin (k + 2)) Λ), + 1 ≤ n_h ∧ n_h ≤ 32 ∧ ReachesIn M n_h (evalCfg s) cfg_h ∧ (step M cfg_h).isNone) ∧ + (∃ s_depth : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR, + ∀ D : ℕ, ValidState (s_depth D) ∧ D ≤ (s_depth D).L.length + (s_depth D).R.length) ∧ + ∃ s₀ : WordSysState Mode TokL TokR numRegsL numRegsR, + ValidState s₀ ∧ + s₀.L.length + s₀.R.length ≤ 4 ∧ + ReachesPlus M (init []) (evalCfg s₀) ∧ + (∃ (n_grow1 n_grow2 : ℕ) (s_g1 s_g2 : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ n_grow1 ∧ n_grow1 < n_grow2 ∧ n_grow2 ≤ 2048 ∧ + iterWordMacro stepMacro n_grow1 s₀ = some s_g1 ∧ + iterWordMacro stepMacro n_grow2 s₀ = some s_g2 ∧ + 32 ≤ totalSystemBitLen specL specR s_g1 ∧ + totalSystemBitLen specL specR s_g1 + 32 ≤ totalSystemBitLen specL specR s_g2 ∧ + 2 ≤ s_g1.L.length + s_g1.R.length ∧ + 4 ≤ s_g1.L.length + s_g1.R.length + numRegsL + numRegsR) ∧ + (∃ (k_d1 k_d2 b₁ b₂ : ℕ) + (s_d1 s_d1' s_d2 s_d2' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_d1 ∧ k_d1 < k_d2 ∧ k_d2 ≤ 2048 ∧ + 26 ≤ b₁ ∧ b₁ < b₂ ∧ + iterWordMacro stepMacro k_d1 s₀ = some s_d1 ∧ stepMacro s_d1 = some s_d1' ∧ + iterWordMacro stepMacro k_d2 s₀ = some s_d2 ∧ stepMacro s_d2 = some s_d2' ∧ + ((s_d1'.regsL = s_d1.regsL ∧ PopsTop s_d1.L s_d1'.L ∧ b₁ = topFrameBitLen specL s_d1.L) ∨ + (s_d1'.regsR = s_d1.regsR ∧ PopsTop s_d1.R s_d1'.R ∧ b₁ = topFrameBitLen specR s_d1.R)) ∧ + ((s_d2'.regsL = s_d2.regsL ∧ PopsTop s_d2.L s_d2'.L ∧ b₂ = topFrameBitLen specL s_d2.L) ∨ + (s_d2'.regsR = s_d2.regsR ∧ PopsTop s_d2.R s_d2'.R ∧ b₂ = topFrameBitLen specR s_d2.R))) ∧ + (numRegsL = 0 → ∃ (k_L : ℕ) (s_L s_L' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_L ∧ k_L ≤ 2048 ∧ + iterWordMacro stepMacro k_L s₀ = some s_L ∧ stepMacro s_L = some s_L' ∧ + s_L'.regsL = s_L.regsL ∧ PopsTop s_L.L s_L'.L ∧ 18 ≤ topFrameBitLen specL s_L.L) ∧ + (numRegsR = 0 → ∃ (k_R : ℕ) (s_R s_R' : WordSysState Mode TokL TokR numRegsL numRegsR), + 64 ≤ k_R ∧ k_R ≤ 2048 ∧ + iterWordMacro stepMacro k_R s₀ = some s_R ∧ stepMacro s_R = some s_R' ∧ + s_R'.regsR = s_R.regsR ∧ PopsTop s_R.R s_R'.R ∧ 18 ≤ topFrameBitLen specR s_R.R) ∧ + (∀ i : Fin numRegsL, ∃ (n_reg : ℕ) (s_reg : WordSysState Mode TokL TokR numRegsL numRegsR), + n_reg ≤ 2048 ∧ iterWordMacro stepMacro n_reg s₀ = some s_reg ∧ 2 ≤ s_reg.regsL i) ∧ + (∀ i : Fin numRegsR, ∃ (n_reg : ℕ) (s_reg : WordSysState Mode TokL TokR numRegsL numRegsR), + n_reg ≤ 2048 ∧ iterWordMacro stepMacro n_reg s₀ = some s_reg ∧ 2 ≤ s_reg.regsR i) ∧ + (∀ m : Mode, ∃ (n_m : ℕ) (s_m : WordSysState Mode TokL TokR numRegsL numRegsR), + n_m ≤ 256 ∧ iterWordMacro stepMacro n_m s₀ = some s_m ∧ s_m.mode = m) ∧ + (∀ t : TokL, ∃ (n_t : ℕ) (s_t : WordSysState Mode TokL TokR numRegsL numRegsR) (d : ℕ), + n_t ≤ 2048 ∧ iterWordMacro stepMacro n_t s₀ = some s_t ∧ (t, d) ∈ s_t.L) ∧ + (∀ t : TokR, ∃ (n_t : ℕ) (s_t : WordSysState Mode TokL TokR numRegsL numRegsR) (d : ℕ), + n_t ≤ 2048 ∧ iterWordMacro stepMacro n_t s₀ = some s_t ∧ (t, d) ∈ s_t.R) ∧ + ((∃ (t_run : TokL) (s_fam : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR), + 1 ≤ specL.stride t_run ∧ + (∃ n_r s_r d_r, n_r ≤ 2048 ∧ iterWordMacro stepMacro n_r s₀ = some s_r ∧ + 1 ≤ d_r ∧ (t_run, d_r) ∈ s_r.L) ∧ + (∀ d : ℕ, ValidState (s_fam d) ∧ + (∃ d₀ rest, d ≤ d₀ ∧ (s_fam d).L = (t_run, d₀) :: rest) ∧ + (∃ s', stepMacro (s_fam d) = some s' ∧ PopsTop (s_fam d).L s'.L ∧ + topFrameBitLen specL (s_fam d).L ≤ totalSystemBitLen specL specR s' + 8))) ∨ + (∃ (t_run : TokR) (s_fam : ℕ → WordSysState Mode TokL TokR numRegsL numRegsR), + 1 ≤ specR.stride t_run ∧ + (∃ n_r s_r d_r, n_r ≤ 2048 ∧ iterWordMacro stepMacro n_r s₀ = some s_r ∧ + 1 ≤ d_r ∧ (t_run, d_r) ∈ s_r.R) ∧ + (∀ d : ℕ, ValidState (s_fam d) ∧ + (∃ d₀ rest, d ≤ d₀ ∧ (s_fam d).R = (t_run, d₀) :: rest) ∧ + (∃ s', stepMacro (s_fam d) = some s' ∧ PopsTop (s_fam d).R s'.R ∧ + topFrameBitLen specR (s_fam d).R ≤ totalSystemBitLen specL specR s' + 8)))) + +/-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ +inductive SegRegionKind (Γ : Type*) where + | reg (blk : List Γ) (val : ℕ) + | wordRun (frames : List (List Γ × ℕ)) + | finWord (words : List (List Γ)) + | gadget (w : List Γ) + +/-- Evaluates a single `SegRegionKind Γ` into its `List Γ` bit-segment. -/ +def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ + | .reg blk v => blk ^ v + | .wordRun [] => [] + | .wordRun ((w, m) :: rest) => (w ^ m) ++ evalSegRegion (.wordRun rest) + | .finWord [] => [] + | .finWord (w :: ws) => w ++ evalSegRegion (.finWord ws) + | .gadget w => w + +/-- Evaluates a `≤ 3`-region segmented half-tape `List (SegRegionKind Γ)` onto `default`. -/ +def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ + | [] => default + | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) + +/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the + valid states): every finite window of every valid half-tape extends to a half-tape that no + valid state encodes, i.e. the image has empty interior in the prefix topology. A + bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family + certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ +def IsNowhereDenseFamily {Γ S : Type*} [Inhabited Γ] + (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := + ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, + (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad + +/-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ +def IsNowhereDenseHalf {Γ S : Type*} [Inhabited Γ] + (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := + IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) + +/-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must + be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view + prefix). -/ +def IsSegmentedCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (SegState : Type) + (Mode : Type) + (ValidSeg : SegState → Prop) + (modeOf : SegState → Mode) + (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) + (evalCfg : SegState → Cfg (Fin (k + 2)) Λ), + (∃ modes : List Mode, 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ + (∀ s, ValidSeg s → (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s))))) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ + (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ + (IsNowhereDenseHalf ValidSeg segsR ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ + (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ + (∀ s, ValidSeg s → + ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + namespace SixState /-- State `A` (`0 : Fin 6`), the initial state. -/ diff --git a/tools/render_challenge.py b/tools/render_challenge.py new file mode 100644 index 00000000..e7b3d586 --- /dev/null +++ b/tools/render_challenge.py @@ -0,0 +1,167 @@ +#!/usr/bin/env python3 +# Copyright 2026 Google LLC +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +"""Synchronizes BusyBeaverChallenge.lean with BusyBeaver/Defs/*.lean. + +Concatenates the declaration bodies of all Defs/*.lean submodules in umbrella +order into the `namespace BusyBeaver` section of BusyBeaverChallenge.lean. +""" + +import argparse +import difflib +import pathlib +import sys + + +START_MARKER = "@[expose] public section\n\nnamespace BusyBeaver\nopen Relation Turing\n" +END_MARKER = "\nnamespace SixState\n" + + +def get_submodules(repo_root: pathlib.Path) -> list[str]: + defs_path = repo_root / "BusyBeaver" / "Defs.lean" + if not defs_path.exists(): + raise FileNotFoundError(f"Missing umbrella file: {defs_path}") + + submodules = [] + prefix = "public import BusyBeaver.Defs." + for line in defs_path.read_text().splitlines(): + line = line.strip() + if line.startswith(prefix): + mod_name = line[len(prefix):].strip() + submodules.append(mod_name) + + if not submodules: + raise ValueError(f"No submodules found in {defs_path}") + return submodules + + +def extract_decl_body(file_path: pathlib.Path, is_first: bool) -> str: + content = file_path.read_text() + ns_idx = content.find("namespace BusyBeaver") + if ns_idx == -1: + raise ValueError(f"Marker 'namespace BusyBeaver' not found in {file_path}") + + after_ns = content[ns_idx + len("namespace BusyBeaver"):] + end_idx = after_ns.rfind("end BusyBeaver") + if end_idx == -1: + raise ValueError(f"Marker 'end BusyBeaver' not found in {file_path}") + + body = after_ns[:end_idx] + lines = body.splitlines() + + start = 0 + while start < len(lines): + line = lines[start].strip() + if not line: + start += 1 + continue + if is_first and line == "open Relation Turing": + start += 1 + continue + if not is_first and line in ( + "open Relation Turing", + "variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ]", + ): + start += 1 + continue + break + + return "\n".join(lines[start:]).strip() + + +def render_challenge(repo_root: pathlib.Path) -> str: + submodules = get_submodules(repo_root) + defs_dir = repo_root / "BusyBeaver" / "Defs" + + bodies = [] + for i, mod_name in enumerate(submodules): + file_path = defs_dir / f"{mod_name}.lean" + if not file_path.exists(): + raise FileNotFoundError(f"Missing submodule file: {file_path}") + body = extract_decl_body(file_path, is_first=(i == 0)) + bodies.append(body) + + rendered_defs = "\n\n".join(bodies) + + challenge_path = repo_root / "BusyBeaverChallenge.lean" + current_content = challenge_path.read_text() + + start_idx = current_content.find(START_MARKER) + if start_idx == -1: + raise ValueError(f"Start marker not found in {challenge_path}") + + end_idx = current_content.find(END_MARKER, start_idx + len(START_MARKER)) + if end_idx == -1: + raise ValueError(f"End marker not found in {challenge_path}") + + prefix = current_content[:start_idx + len(START_MARKER)] + suffix = current_content[end_idx:] + + return f"{prefix}\n{rendered_defs}\n{suffix}" + + +def main() -> int: + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument( + "--repo-root", + type=pathlib.Path, + default=pathlib.Path(__file__).resolve().parent.parent, + help="Path to repository root.", + ) + parser.add_argument( + "--check", + action="store_true", + help="Check whether BusyBeaverChallenge.lean is up to date without writing.", + ) + args = parser.parse_args() + + repo_root = args.repo_root.resolve() + challenge_path = repo_root / "BusyBeaverChallenge.lean" + + try: + new_content = render_challenge(repo_root) + except Exception as e: + print(f"Error rendering challenge: {e}", file=sys.stderr) + return 1 + + current_content = challenge_path.read_text() + + if args.check: + if current_content == new_content: + print("BusyBeaverChallenge.lean is synchronized with BusyBeaver/Defs/*.lean.") + return 0 + else: + diff = difflib.unified_diff( + current_content.splitlines(keepends=True), + new_content.splitlines(keepends=True), + fromfile="BusyBeaverChallenge.lean (current)", + tofile="BusyBeaverChallenge.lean (expected)", + n=3, + ) + print("ERROR: BusyBeaverChallenge.lean is out of sync with BusyBeaver/Defs/*.lean.", file=sys.stderr) + print("Run 'python3 tools/render_challenge.py' to synchronize.", file=sys.stderr) + sys.stderr.writelines(diff) + return 1 + + if current_content != new_content: + challenge_path.write_text(new_content) + print("Updated BusyBeaverChallenge.lean successfully.") + else: + print("BusyBeaverChallenge.lean is already up to date.") + return 0 + + +if __name__ == "__main__": + sys.exit(main()) From f2818406cb98f89cea1961f4649ebc596d199083 Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Fri, 6 Nov 2026 19:07:50 +0000 Subject: [PATCH 4/7] Add CORE_MANIFEST.json and tools/check_manifest.py with CI verification --- .github/workflows/busy_beaver_ci.yml | 4 + CORE_MANIFEST.json | 17 ++++ tools/check_manifest.py | 140 +++++++++++++++++++++++++++ 3 files changed, 161 insertions(+) create mode 100644 CORE_MANIFEST.json create mode 100644 tools/check_manifest.py diff --git a/.github/workflows/busy_beaver_ci.yml b/.github/workflows/busy_beaver_ci.yml index e065bfc3..be5aee77 100644 --- a/.github/workflows/busy_beaver_ci.yml +++ b/.github/workflows/busy_beaver_ci.yml @@ -14,6 +14,7 @@ on: - 'lake-manifest.json' - 'lean-toolchain' - 'tools/**' + - 'CORE_MANIFEST.json' - '.github/workflows/busy_beaver_ci.yml' pull_request: paths: @@ -28,6 +29,7 @@ on: - 'lake-manifest.json' - 'lean-toolchain' - 'tools/**' + - 'CORE_MANIFEST.json' - '.github/workflows/busy_beaver_ci.yml' workflow_dispatch: @@ -49,6 +51,8 @@ jobs: - uses: actions/checkout@fbc6f3992d24b796d5a048ff273f7fcc4a7b6c09 # v5 - name: Check BusyBeaverChallenge is synchronized with Defs run: python3 tools/render_challenge.py --check + - name: Verify core manifest + run: python3 tools/check_manifest.py - uses: leanprover/lean-action@fe408643ea7367d8c0404a8be3975bb145f5fb64 # v1.7.0 with: build-args: "BusyBeaver BusyBeaverChallenge" diff --git a/CORE_MANIFEST.json b/CORE_MANIFEST.json new file mode 100644 index 00000000..a6932ddd --- /dev/null +++ b/CORE_MANIFEST.json @@ -0,0 +1,17 @@ +{ + "core_version": 1, + "files": { + "BusyBeaver/Defs.lean": "6bc7f0bec3703ae922c392a5e5ab161f52aee87109efacd85de84d005082a607", + "BusyBeaver/Defs/Core.lean": "a9a861b14e2fb24df3fce94bdb625d612f9f158a21b8c5abe6261a26460818e5", + "BusyBeaver/Defs/Patterns.lean": "1c3aa83bb4584233d7d4cecc40742e06bd1baf5b3c9397e96361ef4c1421c5c5", + "BusyBeaver/Defs/Stack.lean": "03258c6b05bb7c658643525b133d6abd01650288e8ea9e82053c837ee7146dac", + "BusyBeaver/Defs/Odometer.lean": "aa705cc46d05eb14b9be67cc7a486e40da70065467e32e07d9e9472c29195cf3", + "BusyBeaver/Defs/Transducer.lean": "12cd7052d69b41417bad77228111411b98c3dd6ec513ae7b6440eb7c23831e9f", + "BusyBeaver/Defs/WordRun.lean": "d7bc8ce1bb58c7b4cace2b0c3e2d3cf238759e5c45cc56cd48d2e77460a04a8e", + "BusyBeaver/Defs/Segmented.lean": "d97b734636fd3adb53d7e57e7db44d35d6cd5dee74983c2306bed1633b5c58c2", + "BusyBeaver/Basic.lean": "35cf96b7db7ce0dbd629af00540121d4f64eb18755774356a4309eee9a6a0c4e", + "BusyBeaver/WordRLE.lean": "b819bc8e072a8b2274f60c3cae72f61dbb9057ef9481facbc68801dd4b2ce803", + "BusyBeaver/AffRLE.lean": "8434da7a25f766df93481813f0b17286337df21f35ed55f43845ca93b6903e95", + "BusyBeaver/Cert.lean": "9d23a26b5279bb83b1140920c7b62add4053e01f1f488ef98588363c4cff9496" + } +} diff --git a/tools/check_manifest.py b/tools/check_manifest.py new file mode 100644 index 00000000..49051746 --- /dev/null +++ b/tools/check_manifest.py @@ -0,0 +1,140 @@ +#!/usr/bin/env python3 +# Copyright 2026 Google LLC +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +"""Verifies and updates CORE_MANIFEST.json against repository files. + +Ensures the shared BusyBeaver core files match the pinned SHA256 checksums. +""" + +import argparse +import hashlib +import json +import pathlib +import sys + +CORE_FILES = [ + "BusyBeaver/Defs.lean", + "BusyBeaver/Defs/Core.lean", + "BusyBeaver/Defs/Patterns.lean", + "BusyBeaver/Defs/Stack.lean", + "BusyBeaver/Defs/Odometer.lean", + "BusyBeaver/Defs/Transducer.lean", + "BusyBeaver/Defs/WordRun.lean", + "BusyBeaver/Defs/Segmented.lean", + "BusyBeaver/Basic.lean", + "BusyBeaver/WordRLE.lean", + "BusyBeaver/AffRLE.lean", + "BusyBeaver/Cert.lean", +] + + +def compute_sha256(path: pathlib.Path) -> str: + return hashlib.sha256(path.read_bytes()).hexdigest() + + +def generate_manifest(repo_root: pathlib.Path, core_version: int = 1) -> dict: + files_map = {} + for rel_path in CORE_FILES: + full_path = repo_root / rel_path + if not full_path.exists(): + raise FileNotFoundError(f"Core file not found: {full_path}") + files_map[rel_path] = compute_sha256(full_path) + return { + "core_version": core_version, + "files": files_map, + } + + +def verify_manifest(repo_root: pathlib.Path, manifest_path: pathlib.Path) -> bool: + if not manifest_path.exists(): + print(f"ERROR: Manifest file not found: {manifest_path}", file=sys.stderr) + return False + + try: + manifest = json.loads(manifest_path.read_text()) + except Exception as e: + print(f"ERROR: Failed to parse manifest JSON: {e}", file=sys.stderr) + return False + + manifest_files = manifest.get("files", {}) + all_ok = True + + for rel_path in CORE_FILES: + full_path = repo_root / rel_path + if not full_path.exists(): + print(f"ERROR: Core file missing: {rel_path}", file=sys.stderr) + all_ok = False + continue + + if rel_path not in manifest_files: + print(f"ERROR: File {rel_path} not found in manifest", file=sys.stderr) + all_ok = False + continue + + expected_hash = manifest_files[rel_path] + actual_hash = compute_sha256(full_path) + if actual_hash != expected_hash: + print(f"ERROR: SHA256 mismatch for {rel_path}:", file=sys.stderr) + print(f" expected: {expected_hash}", file=sys.stderr) + print(f" actual: {actual_hash}", file=sys.stderr) + all_ok = False + + for rel_path in manifest_files: + if rel_path not in CORE_FILES: + print(f"WARNING: Unexpected file in manifest: {rel_path}", file=sys.stderr) + + return all_ok + + +def main() -> int: + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument( + "--repo-root", + type=pathlib.Path, + default=pathlib.Path(__file__).resolve().parent.parent, + help="Path to repository root.", + ) + parser.add_argument( + "--manifest", + type=str, + default="CORE_MANIFEST.json", + help="Manifest file name relative to repo root.", + ) + parser.add_argument( + "--update", + action="store_true", + help="Update manifest with current SHA256 hashes.", + ) + args = parser.parse_args() + + repo_root = args.repo_root.resolve() + manifest_path = repo_root / args.manifest + + if args.update: + manifest = generate_manifest(repo_root) + manifest_path.write_text(json.dumps(manifest, indent=2) + "\n") + print(f"Updated {manifest_path} with {len(manifest['files'])} core files.") + return 0 + + if not verify_manifest(repo_root, manifest_path): + print("Core manifest verification FAILED.", file=sys.stderr) + return 1 + + print(f"Core manifest verification PASSED: {len(CORE_FILES)} core files verified.") + return 0 + + +if __name__ == "__main__": + sys.exit(main()) From 0023bd8c18654bf53c95c6de8a0490e1ed35dc78 Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Fri, 6 Nov 2026 19:07:51 +0000 Subject: [PATCH 5/7] Update BusyBeaver/README.md for modular Defs structure and goal predicates --- BusyBeaver/README.md | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/BusyBeaver/README.md b/BusyBeaver/README.md index 3be39eee..33e50a15 100644 --- a/BusyBeaver/README.md +++ b/BusyBeaver/README.md @@ -20,20 +20,33 @@ reflective architecture and verification procedure. ## Behavioral Predicates ([`Defs.lean`](./Defs.lean)) -All proofs in `BusyBeaver/` target machine-checked behavioral predicates over the Post-Turing execution model `BusyBeaver.Machine Γ Λ` starting from the all-blank tape (`BusyBeaver.init []`), capturing both **Level A** (explicit closed `TapePatternSet` or `StackPatternSet` invariants) and **Level B** (explicit accelerated transition systems): - -| Predicate | Meaning | -| :--- | :--- | -| `IsHalt M` | `M` eventually reaches a halting configuration (`(step M cfg).isNone`) from `init []`. | -| `IsNotHalt M` (`IsDoesNotHalt M`) | Every configuration reachable from `init []` has a well-defined successor (`(step M cfg).isSome`). | -| `IsClosedPatternSet M ps` | **Level A (Counter)**: `M`'s blank-tape trajectory enters the explicit `TapePatternSet` `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | -| `HasCollatzReduction M` | `∃ ps, IsClosedPatternSet M ps`. | -| `IsClosedStackPatternSet M ps` | **Level A (Stacked)**: `ps` is well-formed (`IsWellFormedStackPatternSet ps`: non-empty, blank-free block vocabularies, and single-sided stack configuration with at most one `.word` segment), `M`'s blank-tape trajectory enters `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | -| `HasStackedCollatzReduction M` | `∃ ps, IsClosedStackPatternSet M ps` (an existential summary that is always paired in `BusyBeaverChallenge.lean` with a concrete `ps` and an explicit Level B finite-state transducer acceleration). | -| `HasStackReduction M` | **Level A (Two-Sided Stack)**: `M`'s blank-tape trajectory enters a closed two-sided variable-length digit-stack system (`StackTuple`, `IsValidStackModes`) with bounded-prefix views, blank-tape multi-digit stack reachability, and an arbitrary-depth stack-frame transfer transition. | -| `HasOdometerReduction M` | **Level A (Odometer)**: `M`'s blank-tape trajectory enters a closed mixed-radix odometer stack + bit-stream system (`evalOdomR` / `evalOdomL`) with non-trivial odometer stack reachability, certified decrement, zero-capacity drain, reflection, and unconditional push/reflect/halt closure. | -| `HasTransducerReduction M` | **Level A (Transducer)**: `M`'s blank-tape trajectory enters a closed bidirectional macro-word transducer (`IsValidTransducerModes`, `iterTransducerMacro`) over strict-sub-Kraft block alphabets with a halting-verified exit gate and unbounded sweeps in both directions. | -| `IsValidAcceleration M start encode next` | **Level B**: `encode : S → Cfg Γ Λ` and `next : S → Option S` form a certified acceleration of `M` from `start : S` (`init []` reaches `encode start`, `next s = some s'` implies `ReachesPlus M (encode s) (encode s')`, and `next s = none` implies halting from `encode s`), yielding `IsHalt M ↔ CollatzHalts next start`. | +The definition surface is partitioned into modular submodules under [`BusyBeaver/Defs/`](./Defs/) and re-exported through the umbrella module [`BusyBeaver/Defs.lean`](./Defs.lean): + +- **[`Defs/Core.lean`](./Defs/Core.lean)** — Post-Turing execution model (`Stmt`, `Machine`, `Cfg`), reachability relations (`step`, `init`, `multiStep`, `ReachesIn`, `ReachesStar`, `ReachesPlus`), and foundational halting predicates (`IsHalt`, `IsNotHalt`, `IsDoesNotHalt`). +- **[`Defs/Patterns.lean`](./Defs/Patterns.lean)** — Regular-expression tape patterns (`TapeExpr`, `TapePattern`, `VarCond`), pattern set closure (`IsClosedPatternSet`, `HasCollatzReduction`), abstract acceleration halting (`CollatzHalts`, `IsValidAcceleration`), and rule-bounded cryptids (`IsCryptid`). +- **[`Defs/Stack.lean`](./Defs/Stack.lean)** — Stack-word tape patterns (`StackSeg`, `StackExpr`, `StackPattern`), stacked Collatz reductions (`IsClosedStackPatternSet`, `HasStackedCollatzReduction`), bounded half-tape views (`HalfTapeView`, `applyView`), and 2nd-order digit-stack reductions (`HasStackReduction`). +- **[`Defs/Odometer.lean`](./Defs/Odometer.lean)** — Mixed-radix odometer stack and bitstream systems (`OdomSide`, `evalOdomR`, `evalOdomL`, `HasOdometerReduction`). +- **[`Defs/Transducer.lean`](./Defs/Transducer.lean)** — Bidirectional word-stack transducers (`IsValidTransducerModes`, `kraftSum`, `iterTransducerMacro`, `HasTransducerReduction`). +- **[`Defs/WordRun.lean`](./Defs/WordRun.lean)** — Invariant-relative word-run stack systems with accumulator registers (`WordStackSpec`, `IsWordRunCryptid`). +- **[`Defs/Segmented.lean`](./Defs/Segmented.lean)** — Partitioned segmented half-tape schemas (`SegRegionKind`, `IsSegmentedCryptid`). + +All proofs in `BusyBeaver/` target machine-checked behavioral predicates starting from the all-blank tape (`BusyBeaver.init []`): + +| Predicate | Defining Module | Meaning | +| :--- | :--- | :--- | +| `IsHalt M` | `Defs/Core.lean` | `M` eventually reaches a halting configuration (`(step M cfg).isNone`) from `init []`. | +| `IsNotHalt M` (`IsDoesNotHalt M`) | `Defs/Core.lean` | Every configuration reachable from `init []` has a well-defined successor (`(step M cfg).isSome`). | +| `IsClosedPatternSet M ps` | `Defs/Patterns.lean` | **Level A (Counter)**: `M`'s blank-tape trajectory enters the explicit `TapePatternSet` `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | +| `HasCollatzReduction M` | `Defs/Patterns.lean` | `∃ ps, IsClosedPatternSet M ps`. | +| `IsCryptid M` | `Defs/Patterns.lean` | `M` admits an invariant certificate with at most 16 patterns and 32 rules over alphabet size `k + 2`. | +| `IsClosedStackPatternSet M ps` | `Defs/Stack.lean` | **Level A (Stacked)**: `ps` is well-formed (`IsWellFormedStackPatternSet ps`: non-empty, blank-free block vocabularies, and single-sided stack configuration with at most one `.word` segment), `M`'s blank-tape trajectory enters `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | +| `HasStackedCollatzReduction M` | `Defs/Stack.lean` | `∃ ps, IsClosedStackPatternSet M ps` (an existential summary paired in `BusyBeaverChallenge.lean` with a concrete `ps` and an explicit Level B finite-state transducer acceleration). | +| `HasStackReduction M` | `Defs/Stack.lean` | **Level A (Two-Sided Stack)**: `M`'s blank-tape trajectory enters a closed two-sided variable-length digit-stack system (`StackTuple`, `IsValidStackModes`) with bounded-prefix views, blank-tape multi-digit stack reachability, and an arbitrary-depth stack-frame transfer transition. | +| `HasOdometerReduction M` | `Defs/Odometer.lean` | **Level A (Odometer)**: `M`'s blank-tape trajectory enters a closed mixed-radix odometer stack + bit-stream system (`evalOdomR` / `evalOdomL`) with non-trivial odometer stack reachability, certified decrement, zero-capacity drain, reflection, and unconditional push/reflect/halt closure. | +| `HasTransducerReduction M` | `Defs/Transducer.lean` | **Level A (Transducer)**: `M`'s blank-tape trajectory enters a closed bidirectional macro-word transducer (`IsValidTransducerModes`, `iterTransducerMacro`) over strict-sub-Kraft block alphabets with a halting-verified exit gate and unbounded sweeps in both directions. | +| `IsWordRunCryptid M` | `Defs/WordRun.lean` | `M`'s blank-tape trajectory enters a closed invariant-relative word-run stack system with bottom accumulator registers. | +| `IsSegmentedCryptid M` | `Defs/Segmented.lean` | `M`'s blank-tape trajectory enters a closed segmented schema over partitioned half-tapes with register, word-run, finite-word, and gadget regions. | +| `IsValidAcceleration M start encode next` | `Defs/Patterns.lean` | **Level B**: `encode : S → Cfg Γ Λ` and `next : S → Option S` form a certified acceleration of `M` from `start : S` (`init []` reaches `encode start`, `next s = some s'` implies `ReachesPlus M (encode s) (encode s')`, and `next s = none` implies halting from `encode s`), yielding `IsHalt M ↔ CollatzHalts next start`. | ## Foundational Lemmas ([`Basic.lean`](./Basic.lean)) From eda142c3e6b30205217b2b30817f74b66c47f192 Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Sun, 8 Nov 2026 14:41:36 +0000 Subject: [PATCH 6/7] Port remaining 22 BB(6) Hard holdout cryptids and register in comparator - Port all 22 remaining BB(6) Hard holdout cryptid machines identified in the hardness census: * 10 Segmented cryptids under IsSegmentedCryptid in BusyBeaver/BB6/Accelerations/ * 9 Stack cryptids under IsStackCryptid in BusyBeaver/BB6/Accelerations/ * 2 Odometer cryptids under IsOdometerCryptid in BusyBeaver/BB6/Accelerations/ * 1 rule-bounded cryptid under IsCryptid in BusyBeaver/BB6/ - Add supporting stack definitions and lemmas in BusyBeaver/Stack.lean and BusyBeaver/WordRunStack.lean. - Register all 22 machines and viewPrefixLen in comparator/busy_beaver.json, bringing the total verified comparator theorems from 687 to 709. - Regenerate BusyBeaverChallenge.lean and verify core manifest. - Verified: lake build BusyBeaver, lake build BusyBeaverChallenge, and full lake comparator run passing Lean default kernel acceptance across all 709 theorems. --- BusyBeaver.lean | 24 + ...LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean | 596 ++++++ ...LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean | 588 ++++++ ...LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean | 550 ++++++ ...LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean | 1373 ++++++++++++++ ...LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean | 566 ++++++ ...LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean | 1401 ++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean | 1633 +++++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean | 1625 ++++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean | 1581 ++++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean | 1430 +++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean | 1448 +++++++++++++++ ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean | 1548 ++++++++++++++++ ...RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean | 663 +++++++ ...RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean | 664 +++++++ ...RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean | 595 ++++++ ...RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean | 588 ++++++ ...RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean | 596 ++++++ ...RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean | 663 +++++++ ...HH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean | 595 ++++++ ...HH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean | 603 ++++++ ...HH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean | 528 ++++++ BusyBeaver/BB6/Accelerations/README.md | 31 +- ...LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean | 1566 ++++++++++++++++ BusyBeaver/BB6/README.md | 3 +- BusyBeaver/Defs/Odometer.lean | 90 +- BusyBeaver/Defs/Segmented.lean | 14 +- BusyBeaver/Defs/Stack.lean | 39 + BusyBeaver/Defs/WordRun.lean | 15 +- BusyBeaver/README.md | 2 +- BusyBeaver/Stack.lean | 452 +++++ BusyBeaver/WordRunStack.lean | 138 ++ BusyBeaverChallenge.lean | 620 ++++++- CORE_MANIFEST.json | 8 +- comparator/README.md | 4 +- comparator/busy_beaver.json | 51 +- 36 files changed, 22850 insertions(+), 41 deletions(-) create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean create mode 100644 BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean create mode 100644 BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean create mode 100644 BusyBeaver/Stack.lean create mode 100644 BusyBeaver/WordRunStack.lean diff --git a/BusyBeaver.lean b/BusyBeaver.lean index dc4214c7..6d9df347 100644 --- a/BusyBeaver.lean +++ b/BusyBeaver.lean @@ -11,6 +11,8 @@ public import BusyBeaver.Cert public import BusyBeaver.WordRLE public import BusyBeaver.AffRLE public import BusyBeaver.ElabRLE +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack public import BusyBeaver.BB6.Equivalences public import BusyBeaver.BB6.Hardness public import BusyBeaver.BB6.HardnessEvidence @@ -64,11 +66,33 @@ public import BusyBeaver.BB6.M_1RB1RD_1LC0RD_1RF1RB_1LE0RA_0LB0LE_HHH0RC public import BusyBeaver.BB6.M_1RB1RE_1LC0RA_0RD1LB_HHH1RC_1LF1RE_0LB0LE public import BusyBeaver.BB6.M_1RB1RE_1LC0RA_1RD0LB_1LB1RC_1LF0RD_HHH0LE public import BusyBeaver.BB6.M_1RB1RE_1LC1LD_HHH1LA_1LB1LE_0RF0RA_1LD1RF +public import BusyBeaver.BB6.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE public import BusyBeaver.BB6.M_1RB1RF_0LC0RF_1RD1LC_HHH0LE_0RC1LF_1RA0LE public import BusyBeaver.BB6.M_1RB1RF_1LC1LF_0RE1LD_0LB1LD_HHH1RC_1RA0RD public import BusyBeaver.BB6.M_1RB1RF_1LCHHH_1LE1RD_1RA0RC_0LF0LA_0LD0RB public import BusyBeaver.BB6.M_1RBHHH_1RC1LE_0RD0RF_0RE0LA_1LF0LB_1LA1LD public import BusyBeaver.BB6.Accelerations.Stack +public import BusyBeaver.BB6.Accelerations.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE +public import BusyBeaver.BB6.Accelerations.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH +public import BusyBeaver.BB6.Accelerations.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF +public import BusyBeaver.BB6.Accelerations.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA +public import BusyBeaver.BB6.Accelerations.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA +public import BusyBeaver.BB6.Accelerations.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH +public import BusyBeaver.BB6.Accelerations.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD +public import BusyBeaver.BB6.Accelerations.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE +public import BusyBeaver.BB6.Accelerations.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA public import BusyBeaver.BB6.Accelerations.M_1RB0LB_0RC0LD_1LD1RE_0LA0RF_0RD1RF_0RCHHH public import BusyBeaver.BB6.Accelerations.M_1RB0LC_1LC0RE_1LD1LC_1LA1RD_HHH0RF_0LB0RD public import BusyBeaver.BB6.Accelerations.M_1RB0LC_1RC1RE_1LA0LD_0RB0RA_1RB1RF_1RDHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean new file mode 100644 index 00000000..59640901 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean @@ -0,0 +1,596 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 3, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#729` (`1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{0}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨0, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨1, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨3, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨2, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨2, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨0, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨1, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨3, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨3, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨2, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨2, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{5}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mB0, [0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, []), step_mD0_nil L, + Or.inl ⟨(.mCL1, 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mAL, L, [(1, 2)]), step_mD1_nil L, + Or.inl ⟨(.mAL, L, [(1, 2)]), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt (1 :: L) o R, step_mD1_1_to_halt o L R, + Or.inr (step_cfgHalt_isNone o (1 :: L) R)⟩ + · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean new file mode 100644 index 00000000..d2b2520f --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean @@ -0,0 +1,588 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 3, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#560` (`1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_zWord L + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{0}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨0, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨1, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨3, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨2, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨2, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨0, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨1, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨3, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨3, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨2, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨2, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{5}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mB0, [0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt L o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mAL L ((1, 0) :: (z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, 1 :: L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, L, []), step_mD0_nil L, Or.inl ⟨(.mCL1, L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mAL, L, [(1, 0)]), step_mD1_nil L, + Or.inl ⟨(.mAL, L, [(1, 0)]), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt L o R, step_mD1_1_to_halt o L R, Or.inr (step_cfgHalt_isNone o L R)⟩ + · exact ⟨evalCfg (.mAL, L, (1, 0) :: (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mAL, L, (1, 0) :: (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean new file mode 100644 index 00000000..7dcc2658 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean @@ -0,0 +1,550 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` — `is_odometer_cryptid` (`IsOdometerCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 0 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 2000000 +set_option maxRecDepth 10000 + +@[simp] lemma zMz (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 0 = some config := rfl +@[simp] lemma zMo (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 1 = step M config := rfl +@[simp] lemma zMs (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : Nat) : + multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by + rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] + +@[simp] lemma z00 : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl + +@[simp] lemma zDh : (default : zB).head = 0 := rfl +@[simp] lemma zDt : (default : zB).tail = default := rfl + +lemma zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] + +lemma z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢⁺ c₂ := + ⟨1, by decide, zSm tm c₁ c₂ h⟩ + +lemma zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ : Cfg Γ Λ) (n m : Nat) : + multiStep tm c₁ (n + m) = (multiStep tm c₁ n).bind (fun c₂ => multiStep tm c₂ m) := by + induction m with + | zero => simp + | succ m' ih => rw [Nat.add_succ, zMs, ih, Option.bind_assoc]; simp_rw [zMs] + +lemma zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ c3 : Cfg Γ Λ) (n m : Nat) + (h1 : c₁ [tm]⊢^{n} c₂) (h2 : c₂ [tm]⊢^{m} c3) : c₁ [tm]⊢^{n+m} c3 := by + rw [zMa, h1]; simp [h2] + +lemma zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ : Cfg Γ Λ} (h : c₁ [tm]⊢⁺ c₂) : c₁ [tm]⊢* c₂ := by + obtain ⟨n, _, hn⟩ := h; exact ⟨n, hn⟩ + +lemma z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := by + obtain ⟨n, n_pos, hn⟩ := h1; obtain ⟨m, hm⟩ := h2 + exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c₁ c₂ c3 n m hn hm⟩ + +lemma z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := + z02 (z01 tm c₁ c₂ h1) h2 + +lemma zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢⁺ c3) : c₁ [tm]⊢⁺ c3 := + z02 h1 (zPs h2) + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine zPs ?_) <;> + refine z03 (by (try simp only [Turing.ListBlank.head_cons, zDh]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, z00, zDh, zDt]) +local macro "execute" : tactic => `(tactic| repeat (any_goals (first | finish | gstep))) + +lemma fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by + match b with + | ⟨0, _⟩ => left; rfl + | ⟨1, _⟩ => right; rfl + +inductive OdomTok where + | L0 + | L1 + | L2 +deriving DecidableEq, Repr + +@[simp] +def odomWord : OdomTok → List (Fin 2) + | .L0 => [0, 0, 1, 0] + | .L1 => [1, 0, 1, 0] + | .L2 => [1, 1, 0] + +@[simp] +def encOdom : List OdomTok → zB + | [] => [1] +> default + | t :: l => odomWord t +> encOdom l + +lemma encOdom_non_surjective : + ∃ t : zB, ∀ stk : List OdomTok, encOdom stk ≠ t := by + refine ⟨default, fun stk h => ?_⟩ + cases stk with + | nil => + have h1 : (encOdom []).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + | cons t tl => + cases t with + | L0 => + have h1 : (encOdom (.L0 :: tl)).tail.tail.head = (default : zB).tail.tail.head := + congrArg (fun x => x.tail.tail.head) h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, zDt, zDh] at h1 + revert h1; decide + | L1 => + have h1 : (encOdom (.L1 :: tl)).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + | L2 => + have h1 : (encOdom (.L2 :: tl)).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + +@[simp] def state_R (_ : List OdomTok) : Fin 6 := 2 + +@[simp] def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomR .leftOdom (state_R l) [1, 0] (encOdom l) r + +@[simp] def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomL .leftOdom 0 [1, 0] (encOdom l) r + +def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w + +def init_w0 : zB := default + +lemma step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append, z00]; execute + +lemma step_R_0 (l : List OdomTok) (r : zB) : + (cfg_R l ((0 : Fin 2) >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + +lemma step_R_100 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 0 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L2 :: l) r := by + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_R_11 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 1 >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + +lemma step_R_1010 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L0 :: l) r := by + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L0 (l : List OdomTok) (r : zB) : + (cfg_L (.L0 :: l) r) [target_tm]⊢⁺ cfg_R (.L1 :: l) r := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L1 (l : List OdomTok) (r : zB) : + (cfg_L (.L1 :: l) r) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r) := by + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L2 (l : List OdomTok) (r : zB) : + (cfg_L (.L2 :: l) r) [target_tm]⊢⁺ cfg_L l ((0 : Fin 2) >> 1 >> 0 >> r) := by + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_nil (r : zB) : + (cfg_L [] r) [target_tm]⊢⁺ cfg_R [] ((1 : Fin 2) >> 0 >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append, z00]; execute + +@[simp] +def cap : List OdomTok → Nat + | [] => 0 + | .L0 :: l => 2 * cap l + 1 + | .L1 :: l => 2 * cap l + | .L2 :: l => cap l / 3 + +@[simp] +def dec_fuel : Nat → List OdomTok → List OdomTok + | 0, l => l + | _ + 1, [] => [] + | _ + 1, .L0 :: l => .L1 :: l + | n + 1, .L1 :: l => .L0 :: dec_fuel n l + | n + 1, .L2 :: l => .L2 :: dec_fuel n (dec_fuel n (dec_fuel n l)) + +def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l + +@[simp] +lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := by + induction n generalizing l with + | zero => rfl + | succ n ih => + cases l with + | nil => rfl + | cons t tl => cases t <;> simp [dec_fuel, ih] + +@[simp] +lemma length_dec (l : List OdomTok) : (dec l).length = l.length := + length_dec_fuel l.length l + +@[simp] lemma dec_nil : dec [] = [] := rfl +@[simp] lemma dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl +@[simp] lemma dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl +@[simp] lemma dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by + simp only [dec, List.length_cons, dec_fuel, length_dec_fuel] + +lemma cap_dec_aux (n : Nat) : + ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → cap (dec l) = cap l - 1 := by + induction n with + | zero => + intro l hlen h + cases l <;> simp at hlen h + | succ n ih => + intro l hlen h + cases l with + | nil => simp at h + | cons t l => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => simp + | L1 => + simp only [cap, dec_L1] at h ⊢ + have h1 : cap l ≥ 1 := by omega + rw [ih l hlen h1]; omega + | L2 => + simp only [cap, dec_L2] at h ⊢ + have h1 : cap l ≥ 3 := by omega + have ih1 := ih l hlen (by omega) + have hlen1 : (dec l).length ≤ n := by rw [length_dec]; exact hlen + have ih2 := ih (dec l) hlen1 (by omega) + have hlen2 : (dec (dec l)).length ≤ n := by rw [length_dec, length_dec]; exact hlen + have ih3 := ih (dec (dec l)) hlen2 (by omega) + rw [ih3, ih2, ih1]; omega + +lemma cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := + cap_dec_aux l.length l (Nat.le_refl _) h + +lemma runHL_dec_aux (n : Nat) : + ∀ (l : List OdomTok) (r : zB), l.length ≤ n → cap l ≥ 1 → + (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := by + induction n with + | zero => + intro l _ hlen h + cases l <;> simp at hlen h + | succ n ih => + intro l r hlen h + cases l with + | nil => simp at h + | cons t l => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => + simp only [dec_L0] + exact step_L_L0 l r + | L1 => + simp only [cap, dec_L1] at h ⊢ + have h1 : cap l ≥ 1 := by omega + exact zPpp (step_L_L1 l r) + (zPpp (ih l _ hlen h1) (step_R_1010 (dec l) r)) + | L2 => + simp only [cap, dec_L2] at h ⊢ + have hc3 : cap l ≥ 3 := by omega + have hdec1 : cap (dec l) = cap l - 1 := cap_dec l (by omega) + have hdec2 : cap (dec (dec l)) = cap l - 2 := by + rw [cap_dec (dec l) (by omega), hdec1]; omega + have hlen1 : (dec l).length ≤ n := by rw [length_dec]; exact hlen + have hlen2 : (dec (dec l)).length ≤ n := by rw [length_dec]; exact hlen1 + exact zPpp (step_L_L2 l r) + (zPpp (ih l _ hlen (by omega)) + (zPpp (step_R_0 (dec l) _) + (zPpp (ih (dec l) _ hlen1 (by omega)) + (zPpp (step_R_11 (dec (dec l)) _) + (zPpp (ih (dec (dec l)) _ hlen2 (by omega)) + (step_R_100 (dec (dec (dec l))) r)))))) + +lemma runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : + (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := + runHL_dec_aux l.length l r (Nat.le_refl _) h + +@[simp] +def mod3Bits (c : Nat) : List (Fin 2) := + if c % 3 = 0 then [0, 1, 0] + else if c % 3 = 1 then [1, 1, 0] + else [1, 0, 0] + +@[simp] +def drain : List OdomTok → List (Fin 2) + | [] => [1, 0] + | .L0 :: tl => drain tl ++ [1, 0, 1, 0] + | .L1 :: tl => drain tl ++ [1, 0, 1, 0] + | .L2 :: tl => drain tl ++ mod3Bits (cap tl) + +lemma drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] + | [] => by decide + | .L0 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + | .L1 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + | .L2 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + +lemma drain_dec_aux (n : Nat) : + ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → drain (dec l) = drain l := by + induction n with + | zero => + intro l hlen hcap + cases l <;> simp at hlen hcap + | succ n ih => + intro l hlen hcap + cases l with + | nil => simp at hcap + | cons t tl => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => rfl + | L1 => + simp only [cap, dec_L1, drain] at hcap ⊢ + rw [ih tl hlen (by omega)] + | L2 => + simp only [cap, dec_L2, drain] at hcap ⊢ + have hc3 : cap tl ≥ 3 := by omega + have hdec1' : cap (dec tl) = cap tl - 1 := cap_dec tl (by omega) + have hdec2 : cap (dec (dec tl)) = cap tl - 2 := by + rw [cap_dec (dec tl) (by omega), hdec1']; omega + have hdec3 : cap (dec (dec (dec tl))) = cap tl - 3 := by + rw [cap_dec (dec (dec tl)) (by omega), hdec2]; omega + have hlen1 : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have hlen2 : (dec (dec tl)).length ≤ n := by rw [length_dec]; exact hlen1 + have ih1 := ih tl hlen (by omega) + have ih2 := ih (dec tl) hlen1 (by omega) + have ih3 := ih (dec (dec tl)) hlen2 (by omega) + have hmod : mod3Bits (cap (dec (dec (dec tl)))) = mod3Bits (cap tl) := by + simp only [mod3Bits, hdec3] + have hrem : (cap tl - 3) % 3 = cap tl % 3 := by omega + rw [hrem] + rw [ih3, ih2, ih1, hmod] + +lemma drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := + drain_dec_aux l.length l (Nat.le_refl _) hcap + +lemma append_list_assoc (xs ys : List (Fin 2)) (w : zB) : + (xs ++ ys) +> w = xs +> (ys +> w) := by + induction xs with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma run_drain_aux (n : Nat) : + ∀ (l : List OdomTok) (w : zB), l.length ≤ n → cap l = 0 → + (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := by + induction n with + | zero => + intro l w hlen _ + cases l with + | nil => exact step_L_nil w + | cons _ _ => simp at hlen + | succ n ih => + intro l w hlen hcap + cases l with + | nil => exact step_L_nil w + | cons t tl => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => simp only [cap] at hcap; omega + | L1 => + simp only [cap] at hcap + have htl : cap tl = 0 := by omega + simp only [drain, append_list_assoc] + exact zPpp (step_L_L1 tl w) (ih tl ([1, 0, 1, 0] +> w) hlen htl) + | L2 => + simp only [cap] at hcap + simp only [drain, append_list_assoc] + have hcases : cap tl = 0 ∨ cap tl = 1 ∨ cap tl = 2 := by omega + rcases hcases with h0 | h1 | h2 + · have hm : mod3Bits (cap tl) = [0, 1, 0] := by simp [mod3Bits, h0] + rw [hm] + exact zPpp (step_L_L2 tl w) (ih tl ([0, 1, 0] +> w) hlen h0) + · have hm : mod3Bits (cap tl) = [1, 1, 0] := by simp [mod3Bits, h1] + rw [hm] + have hdec1_cap : cap (dec tl) = 0 := by have := cap_dec tl (by omega); omega + have hdec1_len : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have h_ih := ih (dec tl) ([1, 1, 0] +> w) hdec1_len hdec1_cap + rw [drain_dec tl (by omega)] at h_ih + exact zPpp (step_L_L2 tl w) + (zPpp (runHL_dec tl ((0 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_0 (dec tl) ((1 : Fin 2) >> 0 >> w)) h_ih)) + · have hm : mod3Bits (cap tl) = [1, 0, 0] := by simp [mod3Bits, h2] + rw [hm] + have hdec1_cap : cap (dec tl) = 1 := by have := cap_dec tl (by omega); omega + have hdec2_cap : cap (dec (dec tl)) = 0 := by + have := cap_dec (dec tl) (by omega); omega + have hdec1_len : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have hdec2_len : (dec (dec tl)).length ≤ n := by rw [length_dec]; exact hdec1_len + have h_ih := ih (dec (dec tl)) ([1, 0, 0] +> w) hdec2_len hdec2_cap + rw [drain_dec (dec tl) (by omega), drain_dec tl (by omega)] at h_ih + exact zPpp (step_L_L2 tl w) + (zPpp (runHL_dec tl ((0 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_0 (dec tl) ((1 : Fin 2) >> 0 >> w)) + (zPpp (runHL_dec (dec tl) ((1 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_11 (dec (dec tl)) ((0 : Fin 2) >> w)) h_ih)))) + +lemma run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : + (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := + run_drain_aux l.length l w (Nat.le_refl _) hcap + +def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := + if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) + +lemma stepL_state_sound (l : List OdomTok) (w : zB) : + (cfg_L l w) [target_tm]⊢⁺ cfg_R (stepL_state l w).1 (stepL_state l w).2 := by + unfold stepL_state + split_ifs with hcap + · exact runHL_dec l w hcap + · have hz : cap l = 0 := by omega + exact run_drain l w hz + +lemma step_R_partition (l : List OdomTok) (w : zB) + (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : + (∃ t w', (cfg_R l w) [target_tm]⊢⁺ cfg_R (t :: l) w') ∨ + (∃ w', (cfg_R l w) [target_tm]⊢⁺ cfg_L l w') ∨ + (∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) := by + rcases fin2_cases w.head with h0 | h1 + · have hw0 : w = (0 : Fin 2) >> w.tail := by + conv_lhs => rw [← ListBlank.cons_head_tail w, h0] + rw [hw0] + exact Or.inr (Or.inl ⟨(1 : Fin 2) >> w.tail, step_R_0 l w.tail⟩) + · rcases fin2_cases w.tail.head with h10 | h11 + · rcases fin2_cases w.tail.tail.head with h100 | h101 + · have hw : w = (1 : Fin 2) >> 0 >> 0 >> w.tail.tail.tail := by + conv_lhs => + rw [← ListBlank.cons_head_tail w, h1, + ← ListBlank.cons_head_tail w.tail, h10, + ← ListBlank.cons_head_tail w.tail.tail, h100] + rw [hw] + exact Or.inl ⟨.L2, w.tail.tail.tail, step_R_100 l w.tail.tail.tail⟩ + · rcases fin2_cases w.tail.tail.tail.head with h1010 | h1011 + · have hw : w = (1 : Fin 2) >> 0 >> 1 >> 0 >> w.tail.tail.tail.tail := by + conv_lhs => + rw [← ListBlank.cons_head_tail w, h1, + ← ListBlank.cons_head_tail w.tail, h10, + ← ListBlank.cons_head_tail w.tail.tail, h101, + ← ListBlank.cons_head_tail w.tail.tail.tail, h1010] + rw [hw] + exact Or.inl ⟨.L0, w.tail.tail.tail.tail, step_R_1010 l w.tail.tail.tail.tail⟩ + · rcases hguard with hg0 | ⟨_, hg2 | hg3⟩ + · rw [h1] at hg0; nomatch hg0 + · rw [h101] at hg2; nomatch hg2 + · rw [h1011] at hg3; nomatch hg3 + · rcases hguard with hg0 | ⟨hg1, _⟩ + · rw [h1] at hg0; nomatch hg0 + · rw [h11] at hg1; nomatch hg1 + +lemma step_R_closed (l : List OdomTok) (w : zB) + (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : + ∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ + (IsInOdomSystem cfg' ∨ (step target_tm cfg').isNone) := by + rcases step_R_partition l w hguard with ⟨t, w', hpush⟩ | ⟨w', hrefl⟩ | ⟨cfg_halt, hhalt, hnone⟩ + · exact ⟨cfg_R (t :: l) w', hpush, Or.inl ⟨t :: l, w', rfl⟩⟩ + · exact ⟨cfg_R (stepL_state l w').1 (stepL_state l w').2, + zPpp hrefl (stepL_state_sound l w'), + Or.inl ⟨(stepL_state l w').1, (stepL_state l w').2, rfl⟩⟩ + · exact ⟨cfg_halt, hhalt, Or.inr hnone⟩ + +lemma step_init_nontrivial : + (init []) [target_tm]⊢⁺ cfg_R [.L0, .L2, .L0] default := by + have h0 : (init []) [target_tm]⊢⁺ cfg_R [] default := step_init + have h1 : (cfg_R [] default) [target_tm]⊢⁺ cfg_L [] ((1 : Fin 2) >> default) := by + have h := step_R_0 [] default; rwa [z00] at h + have h2 := step_L_nil ((1 : Fin 2) >> default) + have h3 : (cfg_R [] ((1 : Fin 2) >> 0 >> 1 >> default)) [target_tm]⊢⁺ cfg_R [.L0] default := by + have h := step_R_1010 [] default; rwa [z00] at h + have h4 : (cfg_R [.L0] default) [target_tm]⊢⁺ cfg_L [.L0] ((1 : Fin 2) >> default) := by + have h := step_R_0 [.L0] default; rwa [z00] at h + have h5 := step_L_L0 [] ((1 : Fin 2) >> default) + have h6 : (cfg_R [.L1] ((1 : Fin 2) >> default)) [target_tm]⊢⁺ cfg_R [.L2, .L1] default := by + have h := step_R_100 [.L1] default; rwa [z00, z00] at h + have h7 : (cfg_R [.L2, .L1] default) [target_tm]⊢⁺ cfg_L [.L2, .L1] ((1 : Fin 2) >> default) := by + have h := step_R_0 [.L2, .L1] default; rwa [z00] at h + have h8 : (cfg_L [.L2, .L1] ((1 : Fin 2) >> default)) [target_tm]⊢⁺ + cfg_R [] ((1 : Fin 2) >> 0 >> 1 >> 0 >> 1 >> 0 >> 0 >> 1 >> 0 >> 1 >> default) := + run_drain [.L2, .L1] ((1 : Fin 2) >> default) rfl + have h9 := step_R_1010 [] ((1 : Fin 2) >> 0 >> 0 >> 1 >> 0 >> 1 >> default) + have h10 := step_R_100 [.L0] ((1 : Fin 2) >> 0 >> 1 >> default) + have h11 : (cfg_R [.L2, .L0] ((1 : Fin 2) >> 0 >> 1 >> default)) [target_tm]⊢⁺ + cfg_R [.L0, .L2, .L0] default := by + have h := step_R_1010 [.L2, .L0] default; rwa [z00] at h + exact zPpp h0 (zPpp h1 (zPpp h2 (zPpp h3 (zPpp h4 (zPpp h5 (zPpp h6 + (zPpp h7 (zPpp h8 (zPpp h9 (zPpp h10 h11)))))))))) + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by + refine ⟨OdomTok, .leftOdom, state_R, 0, [1, 0], [1, 0], [1], odomWord, encOdom, cap, dec, + (fun _ => []), drain, IsInOdomSystem, ?_, ?_, ?_, rfl, ?_, encOdom_non_surjective, rfl, ?_, + length_dec, cap_dec, runHL_dec, (fun stk _ => drain_ne_nil stk), run_drain, + step_R_0, step_R_partition, (fun _ => Iff.rfl), + ⟨[.L0, .L2, .L0], default, step_init_nontrivial, by decide, by decide⟩, step_R_closed⟩ + · refine ⟨[.L0, .L1, .L2], by decide, by decide, ?_⟩ + intro t; cases t <;> decide + · decide + · intro t; cases t <;> decide + · intro t stk; rfl + · refine ⟨.L0, .L1, .L2, 3, [1, 0, 1, 0], [1, 0, 0], + by decide, by decide, by decide, (fun _ => rfl), (fun _ => rfl), (fun _ => rfl), + step_R_1010, step_R_100⟩ + +end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean new file mode 100644 index 00000000..13f80ee7 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean @@ -0,0 +1,1373 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 0 Dir.right) + | 3, 1 => some (some 5, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 1 Dir.left) + | 5, 0 => some (some 1, Stmt.write 0 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 2 +def B : Fin 6 := 0 +def C : Fin 6 := 1 +def D : Fin 6 := 4 +def E : Fin 6 := 3 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +@[simp] lemma pow_zero_list (u : List (Fin 2)) : u ^ (0 : Nat) = [] := rfl +@[simp] lemma pow_succ_list (u : List (Fin 2)) (n : Nat) : u ^ (n + 1) = u ++ u ^ n := rfl +@[simp] lemma nil_append_list (l : List (Fin 2)) : ([] : List (Fin 2)) ++ l = l := rfl +@[simp] lemma cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : (x :: xs) ++ ys = x :: (xs ++ ys) := rfl +@[simp] lemma append_nil_list (l : List (Fin 2)) : l ++ [] = l := List.append_nil l +@[simp] lemma listblank_append_nil (b : ListBlank (Fin 2)) : ([] : List (Fin 2)) +> b = b := rfl +@[simp] lemma listblank_append_cons (x : Fin 2) (xs : List (Fin 2)) (b : ListBlank (Fin 2)) : + (x :: xs) +> b = x >> (xs +> b) := rfl +@[simp] lemma zero_cons_default : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl +@[simp] lemma default_head : (default : ListBlank (Fin 2)).head = 0 := rfl +@[simp] lemma default_tail : (default : ListBlank (Fin 2)).tail = default := rfl +@[simp] lemma init_nil : (init ([] : List (Fin 2))) = ⟨some B, ⟨0, default, default⟩⟩ := rfl + +omit [Inhabited Γ] in +theorem list_pow_add (l : List Γ) (n m : Nat) : l^(n + m) = l^n ++ l^m := + BusyBeaver.list_pow_add l n m + +@[simp] lemma zero_pow_append_default (n : ℕ) : + (([0] : List (Fin 2)) ^ n) +> (default : ListBlank (Fin 2)) = default := by + induction n with + | zero => rfl + | succ n' ih => + rw [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, zero_cons_default] + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +local notation3 l " <{{" q "}}ₘ " r => (r {{q}}> l) + +abbrev cfgA (l r : ListBlank (Fin 2)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, r, l⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + evalStackCfg .M0 R L + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma in_stack_M0 (L R : List (ℕ × ℕ)) : IsInStackSystem (cfg_M0 L R) := + ⟨.M0, R, L, rfl⟩ + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = cfgA (encTail L) (encTail R) := by + simp [cfg_M0, evalStackCfg, cfgA, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + try rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_head_one (l r : ListBlank (Fin 2)) : + (step target_tm ⟨some F, ⟨1, l, r⟩⟩).isNone = true := by + unfold step + simp only [F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [], ?_, in_stack_M0 [] []⟩ + rw [init_nil, cfg_M0_eq, encTail_nil] + execute 5 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}}ₘ ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + cfgA (W +> wall L'') (encRight R) + +inductive FState + | F00 | F01 | F02 | F04 | F05 | F07 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}}ₘ ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{D}}ₘ ((0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{C}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}}ₘ ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{D}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{A}}ₘ ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- ============================================================================ +-- Stage 1: `cfg_M0 L R` -> `cfg_M0`, Halt, or `cfg_D 0` +-- ============================================================================ + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 5 + +lemma M0_add3 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 3, bR) :: R')) [target_tm]⊢⁺ + ⟨some F, ⟨1, encTail ((d, bR) :: R'), (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L⟩⟩ := by + rw [cfg_M0_eq, encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d] + execute 3 + +theorem stage1_step (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr (Or.inr ⟨L, [], rfl⟩)⟩ + · rcases d with _ | _ | _ | d' + · exact ⟨_, M0_zero L bR R', Or.inr (Or.inr ⟨L, peelSep bR R', rfl⟩)⟩ + · exact ⟨_, M0_one L bR R', Or.inl (in_stack_M0 ((0, 0) :: tailAsRight L) (peelSep bR R'))⟩ + · exact ⟨_, M0_two L bR R', Or.inl (in_stack_M0 ((0, 1) :: tailAsRight L) (peelSep bR R'))⟩ + · exact ⟨_, M0_add3 L d' bR R', Or.inr (Or.inl (F_halt_head_one _ _))⟩ + +-- ============================================================================ +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +def measureD : List (ℕ × ℕ) → ℕ + | [] => 0 + | (a, _) :: L => a + 1 + measureD L + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ + cfgA tL ((1 : Fin 2) >> rD) := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ + cfgA ((0 : Fin 2) >> tL) ((0 : Fin 2) >> (1 : Fin 2) >> rD) := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ + (tL <{{D}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ + cfgA ((0 : Fin 2) >> tL) ((1 : Fin 2) >> rD) := by + execute 5 + +lemma D_leaf_1 (tL rD' : ListBlank (Fin 2)) : + (((1 : Fin 2) >> tL) <{{D}}ₘ ((0 : Fin 2) >> rD')) [target_tm]⊢⁺ + (tL <{{D}}ₘ ((0 : Fin 2) >> (1 : Fin 2) >> rD')) := by + execute 3 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ measureD L' < measureD L ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, c) :: tailAsRight R))⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, c) :: tailAsRight R))⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] _)⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp [measureD]; omega, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] _)⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = a₁' + 1 -> D_leaf_1 + have hL : encTail ((a₁' + 1, b₁) :: L') = (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := + encTail_succ a₁' b₁ L' + rw [hL] + rcases c with _ | c' + · -- c = 0 + refine ⟨cfg_D 0 ((a₁', b₁) :: L') (rightAsTail (tailAsRight R)), ?_, + Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', rightAsTail (tailAsRight R), by decide, by simp [measureD], rfl⟩))⟩ + unfold cfg_D + rw [encTail_rightAsTail, encRight_tailAsRight] + dsimp only [rD, pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + exact D_leaf_1 (encTail ((a₁', b₁) :: L')) ((1 : Fin 2) >> encTail R) + · -- c = c' + 1 + have hc' : c' < 4 := by omega + refine ⟨cfg_D 0 ((a₁', b₁) :: L') ((0, c') :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', (0, c') :: tailAsRight R, by decide, by simp [measureD], rfl⟩))⟩ + unfold cfg_D + rw [← one_cons_RD_eq c' hc' R] + dsimp only [rD, pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + exact D_leaf_1 (encTail ((a₁', b₁) :: L')) ((([0] : List (Fin 2)) ^ (1 + c')) +> ((1 : Fin 2) >> encTail R)) + +theorem stage2_closed (n : ℕ) : + ∀ L, measureD L ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ +-- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) +-- ============================================================================ + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 0 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 1 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by + rw [w_peelInner_zero b S h] + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +-- Stage 3 P transitions +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 5 + +lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + unfold P_cfg + rw [encRight_one_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ + ⟨some F, ⟨1, encTail ((a, b) :: R_tail), (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (W +> wall L'')⟩⟩ := by + dsimp only [P_cfg] + rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_eq_one_cons_encTail a b R_tail] + execute 3 + +-- Stage 3 F transitions on bit 0 +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 + +-- Stage 3 F transitions on bit 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 +lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 3 +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W ((0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 3 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 + +-- Pushdown predicate & bit-step combinators +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + | F02 => + have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ + rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F04 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F05 => + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F07 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => + have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + refine Or.inr ⟨.F01, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + rw [w_bumpHead R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F02 => + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + | F04 => + refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F05 => + refine Or.inr ⟨.F01, (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F07 => + refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | _ | a' + · -- a = 0 + have hw0 : w ((0, b) :: R_tail) = W_val := hw_ab + rcases R_tail with _ | ⟨r₂, rs⟩ + · -- R = [(0, b)] -> P_step_0_other + refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · -- P_step_0_rec -> calls Qz1 (r₂ :: rs) via ih_tail! + have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · -- b % 4 = 1 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 2 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 3 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = 1 + have hw1_eq : w ((1, b) :: R_tail) = W_val := hw_ab + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · -- P_step_1_rec: R_tail ≠ [] and b % 4 = 0 + obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p := P_step_1_rec L'' W_base b hb0 R_tail hne_tail + have hw_tail : w R_tail + 1 = w ((1, b) :: R_tail) := by + rw [w_cons_nonempty 1 b R_tail hne_tail] + have hb2 : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' (0 :: 1 :: W_base) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach1 := stepPlus_trans h_p h1 + have hc0 := C0_le_C1_succ s1 + have hw1_c0 : w R1 + C0 s1 ≤ W_val := by omega + rcases step_bit0 h_reach1 hR1 hw1_c0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · exact step_bit1 h2 hR2 hw2 ih_z + · -- P_step_1_other: R_tail = [] ∨ b % 4 ≠ 0 + have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have h_p := P_step_1_other L'' W_base b R_tail hcond + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hw1 : w R1 + 1 = w ((1, b) :: R_tail) := w_peelInner_one b R_tail hcond + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + rcases hQ0_R1 L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R2, hR2, hw2, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach2 := stepPlus_trans h_p h1 + have hc1 := C1_le_C0_succ s0 + have hw2_c1 : w R2 + C1 s0 ≤ W_val := by omega + exact step_bit1 h_reach2 hR2 hw2_c1 ih_z + · -- a = a' + 2 -> P_step_ge2 halts! + exact Or.inl ⟨_, P_step_ge2 L'' W_base a' b R_tail, F_halt_head_one _ _⟩ + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +-- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by + cases s with + | F00 => exact ⟨_, _, F00_exit L'' R⟩ + | F01 => exact ⟨_, _, F01_exit L'' R⟩ + | F02 => exact ⟨_, _, F02_exit L'' R⟩ + | F04 => exact ⟨_, _, F04_exit L'' R⟩ + | F05 => exact ⟨_, _, F05_exit L'' R⟩ + | F07 => exact ⟨_, _, F07_exit L'' R⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, _, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · obtain ⟨L_out, R_out', h2⟩ := F_exit_all s L'' R_out + exact ⟨cfg_M0 L_out R_out', stepPlus_trans h1 h2, Or.inl (in_stack_M0 L_out R_out')⟩ + +-- ============================================================================ +-- Closure & Main Theorem +-- ============================================================================ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, R, L, hcfg⟩ + subst hcfg + cases m with + | M0 => + change ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ _ + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step L R + rcases hout₁ with hM₁ | hH₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · exact ⟨cfg₁, h₁, Or.inr hH₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed (measureD L₁) L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +-- ============================================================================ +-- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield +-- ============================================================================ + +lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} + (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := + stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ +lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (0, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_0_rec L'' W 0 rfl (List.replicate k (0, 0) ++ R_tail) hne) + (ih (0 :: 1 :: W)) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ +lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (1, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_1_rec L'' W 0 rfl (List.replicate k (1, 0) ++ R_tail) hne) + (ih (0 :: 0 :: 1 :: W)) + +/-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ +lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ + cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by + rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R + have h0 : 0 % 4 = 0 := rfl + have hL_enc : encTail ((0, 0) :: (0, 0) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, h0, encRight_cons_eq_one_cons_encTail, encTail_zero, h0, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL_enc] + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + +/-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ +lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* + cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by + induction k generalizing R with + | zero => + simp only [Nat.mul_zero, List.replicate_zero, List.nil_append, + Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + rw [Function.iterate_succ_apply] + have h_rep : List.replicate (2 * (k + 1)) (0, 0) ++ L_rest = + (0, 0) :: (0, 0) :: (List.replicate (2 * k) (0, 0) ++ L_rest) := by + have h2 : 2 * (k + 1) = 2 * k + 2 := by omega + rw [h2] + rfl + rw [h_rep] + have hne : List.replicate (2 * k) (0, 0) ++ L_rest ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hL + exact stepPlus_stepStar_trans + (D_pop_double_zero 2 (by decide) (List.replicate (2 * k) (0, 0) ++ L_rest) R hne) + (ih ((0, 2) :: tailAsRight R)) + +/-- Stage 2 empty-left-stack return to `cfg_M0`. -/ +lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 ((1, bR) :: R') L`. -/ +theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 ((1, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 (peelSep bR R') ((0, 0) :: tailAsRight L), + M0_one L bR R', in_stack_M0 ((0, 0) :: tailAsRight L) (peelSep bR R')⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 ((2, bR) :: R') L`. -/ +theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 ((2, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 (peelSep bR R') ((0, 1) :: tailAsRight L), + M0_two L bR R', in_stack_M0 ((0, 1) :: tailAsRight L) (peelSep bR R')⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ +theorem mode_M0_nil_nil_nonhalting : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + in_stack_M0 [] ((1, 0) :: tailAsRight [])⟩ + +/-- Refined reachable stack subset for Holdout `#278`: canonical `evalStackCfg m L R` + configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ +def ValidStack278 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +theorem validStack278_subset_isInStackSystem : + ∀ cfg, ValidStack278 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +theorem cfg_M0_nil_nil_reaches_validStack278 : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack278 cfg' := + ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, (1, 0) :: tailAsRight [], [], rfl, Or.inl (by simp)⟩⟩ + +theorem init_reaches_validStack278 : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack278 cfg₀ := by + have h0 : (init []) [target_tm]⊢⁺ evalStackCfg .M0 [] [] := by + change (init []) [target_tm]⊢⁺ cfg_M0 [] [] + rw [init_nil, cfg_M0_eq, encTail_nil] + execute 5 + obtain ⟨cfg₁, h₁, hvalid₁⟩ := cfg_M0_nil_nil_reaches_validStack278 + exact ⟨cfg₁, stepPlus_trans h0 h₁, hvalid₁⟩ + +theorem stack_system_steps_to_validStack278 : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack278 cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg hcfg + obtain ⟨cfg₁, h₁, hout⟩ := stack_system_closed cfg hcfg + rcases hout with ⟨m, L, R, rfl⟩ | hhalt + · cases m with + | M0 => + rcases L with _ | ⟨pL, L'⟩ + · rcases R with _ | ⟨pR, R'⟩ + · obtain ⟨cfg₂, h₂, hvalid₂⟩ := cfg_M0_nil_nil_reaches_validStack278 + exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hvalid₂⟩ + · exact ⟨evalStackCfg .M0 [] (pR :: R'), h₁, + Or.inl ⟨.M0, [], pR :: R', rfl, Or.inr (by simp)⟩⟩ + · exact ⟨evalStackCfg .M0 (pL :: L') R, h₁, + Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ + · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ + +theorem validStack278_step_closed : + ∀ cfg, ValidStack278 cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack278 cfg' ∨ (step target_tm cfg').isNone) := + fun cfg hvalid => + stack_system_steps_to_validStack278 cfg (validStack278_subset_isInStackSystem cfg hvalid) + +/-- Stage 2 singleton-zero return to `cfg_M0`. -/ +lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : + (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := + RD_eq_encTail_one c hc R + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Stage 2 transition from `cfg_D c ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') R` into `P_cfg`. -/ +lemma D_00_13_to_P (c : ℕ) (hc : c < 4) (a₃ b₃ : ℕ) (L''' R : List (ℕ × ℕ)) : + (cfg_D c ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') R) [target_tm]⊢⁺ + P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := + RD_eq_encRight c hc R + have h0 : 0 % 4 = 0 := rfl + have h3 : 3 % 4 = 3 := rfl + have hL : encTail ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, h0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h3, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + +/-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [] [(0, b₁)]`. -/ +theorem mode_M0_nil_singleton_zero_nonhalting (b₁ : ℕ) : + ∃ cfg', ((evalStackCfg .M0 [] [(0, b₁)]) [target_tm]⊢⁺ cfg') ∧ + ValidStack278 cfg' := + ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], + stepPlus_trans (M0_nil [(0, b₁)]) (D_singleton_zero_return 0 (by decide) b₁ []), + ⟨.M0, (1, 0) :: tailAsRight [], [], rfl, Or.inl (by simp)⟩⟩ + +/-- Stage 1 halting counterexample family in `ValidStack278`: any + `evalStackCfg .M0 ((d + 3, bR) :: R') L` satisfies `ValidStack278` and halts + in 3 steps via `M0_add3` and `F_halt_head_one`. -/ +theorem counterexample_validStack278_M0_add3_halts + (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + ValidStack278 (evalStackCfg .M0 ((d + 3, bR) :: R') L) ∧ + ∃ cfg', ((evalStackCfg .M0 ((d + 3, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := + ⟨⟨.M0, (d + 3, bR) :: R', L, rfl, Or.inl (by simp)⟩, + ⟨⟨some F, ⟨1, encTail ((d, bR) :: R'), + (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L⟩⟩, + M0_add3 L d bR R', F_halt_head_one _ _⟩⟩ + +/-- Stage 3 halting counterexample family in `ValidStack278`: any + `evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')` + satisfies `ValidStack278`, enters Stage 2 via `M0_zero`, transitions to Stage 3 via + `D_00_13_to_P`, pops `(0, 0)` via `P_step_0_rec`, and halts via `P_step_ge2`. -/ +theorem counterexample_validStack278_stage3_P_ge2_halts + (a b a₃ b₃ : ℕ) (R_tail L''' : List (ℕ × ℕ)) : + ValidStack278 (evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) + ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) + ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (0, 0) :: (a + 1, b) :: R_tail, + (0, 0) :: (1, 3) :: (a₃, b₃) :: L''', rfl, Or.inl (by simp)⟩, ?_⟩ + have h1 : (evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) + ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')) [target_tm]⊢⁺ + cfg_D 0 ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') ((a + 2, b) :: R_tail) := + M0_zero ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') 0 ((a + 1, b) :: R_tail) + have h2 : (cfg_D 0 ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg ((a₃, b₃) :: L''') [] ((0, 0) :: (a + 2, b) :: R_tail) := + D_00_13_to_P 0 (by decide) a₃ b₃ L''' ((a + 2, b) :: R_tail) + have h3 : (P_cfg ((a₃, b₃) :: L''') [] ((0, 0) :: (a + 2, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg ((a₃, b₃) :: L''') [0, 1] ((a + 2, b) :: R_tail) := + P_step_0_rec ((a₃, b₃) :: L''') [] 0 rfl ((a + 2, b) :: R_tail) (by simp) + have h4 := P_step_ge2 ((a₃, b₃) :: L''') [0, 1] a b R_tail + exact ⟨_, stepPlus_trans (stepPlus_trans (stepPlus_trans h1 h2) h3) h4, F_halt_head_one _ _⟩ + +end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean new file mode 100644 index 00000000..9ebc83b2 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean @@ -0,0 +1,566 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 3, Stmt.write 1 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 0 Dir.left) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 0 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +inductive SegMode where + | mAR + | mA0R + | mEL +deriving DecidableEq, Repr + +@[simp] +def onesSep0 : ℕ → List (Fin 2) + | 0 => [0] + | d + 1 => 1 :: onesSep0 d + +@[simp] +def lWord (d : ℕ) : List (Fin 2) := 1 :: onesSep0 d + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | d :: L => lWord d +> encLeft L + +@[simp] +def rWord : ℕ → List (Fin 2) + | 0 => [1] + | z + 1 => 0 :: rWord z + +@[simp] +def encRight : List ℕ → zB + | [] => default + | z :: R => rWord z +> encRight R + +abbrev SegState := SegMode × List ℕ × List ℕ + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_lWord (L : List ℕ) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +lemma evalSegRegion_rWord (R : List ℕ) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma enc_nth_zero (d : ℕ) (L : List ℕ) : + (encLeft (d :: L)).nth 0 = 1 := by + simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + +lemma noFactor_001_nil (d : ℕ) : + WordRunStack.NoFactor [0, 0, 1] (lWord d +> (default : zB)) := by + have hd : WordRunStack.NoFactor [0, 0, 1] (default : zB) := + WordRunStack.noFactor_default [0, 0, 1] 2 (by decide) (by decide) + induction d with + | zero => + simp only [lWord, onesSep0, ListBlank.append, zero_cons_default] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) default hd 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ d ih => + change WordRunStack.NoFactor [0, 0, 1] ((1 : Fin 2) >> (lWord d +> default)) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_001_cons (d : ℕ) (t : zB) (ht0 : t.nth 0 = 1) + (ht : WordRunStack.NoFactor [0, 0, 1] t) : + WordRunStack.NoFactor [0, 0, 1] (lWord d +> t) := by + induction d with + | zero => + simp only [lWord, onesSep0, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ d ih => + change WordRunStack.NoFactor [0, 0, 1] ((1 : Fin 2) >> (lWord d +> t)) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_enc : ∀ L : List ℕ, WordRunStack.NoFactor [0, 0, 1] (encLeft L) + | [] => WordRunStack.noFactor_default [0, 0, 1] 2 (by decide) (by decide) + | [d] => noFactor_001_nil d + | d :: d2 :: L => + noFactor_001_cons d (encLeft (d2 :: L)) (enc_nth_zero d2 L) + (noFactor_enc (d2 :: L)) + +lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 1] + (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_enc L) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List ℕ → Cfg (Fin 2) (Fin 6) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mA0R, L, R => (applyView (.id [0]) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mEL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id []) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAR => + refine ⟨0, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mA0R => + refine ⟨0, .id [0], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mEL => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsR_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vL, + (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = vL {{q}}> (evalSegmentedHalf (segsR s))) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsR] + cases m with + | mAR => exact ⟨0, applyView (.id []) (encLeft L), Or.inr (Or.inr rfl)⟩ + | mA0R => exact ⟨0, applyView (.id [0]) (encLeft L), Or.inr (Or.inr rfl)⟩ + | mEL => exact ⟨4, applyView (.id []) (encLeft L), Or.inr (Or.inl rfl)⟩ + +@[simp] +def bump1L : List ℕ → List ℕ + | [] => [0] + | d :: xs => (d + 1) :: xs + +lemma one_cons_encLeft (xs : List ℕ) : + (1 : Fin 2) >> encLeft xs = encLeft (bump1L xs) := by + cases xs <;> simp [bump1L, encLeft, lWord, onesSep0, ListBlank.append, zero_cons_default] +@[simp] +def push0R : List ℕ → List ℕ + | [] => [] + | z :: xs => (z + 1) :: xs + +lemma zero_cons_encRight (xs : List ℕ) : + (0 : Fin 2) >> encRight xs = encRight (push0R xs) := by + cases xs <;> simp [push0R, encRight, rWord, ListBlank.append, zero_cons_default] + +@[simp] +def s₀ : SegState := (.mAR, (0 :: []), (1 :: [])) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: []) (1 :: []) := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma stepOut_trans {c1 c2 : Cfg (Fin 2) (Fin 6)} + (h1 : c1 [target_tm]⊢⁺ c2) + (h2 : ∃ cfg', (c2 [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone)) : + ∃ cfg', (c1 [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + rcases h2 with ⟨cfg', h2p, hend⟩ + exact ⟨cfg', stepPlus_trans h1 h2p, hend⟩ + +lemma step_mAR_2_loop (L : List ℕ) (Rt : List ℕ) : + (evalSegCfg .mAR L (2 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: bump1L L) Rt := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_1 (L : List ℕ) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ + evalSegCfg .mAR (bump1L L) (1 :: []) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_2 (Rt : List ℕ) : + (evalSegCfg .mAR [] (0 :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mEL [] (0 :: (push0R Rt)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_3 (lt2 : List ℕ) (Rt : List ℕ) : + (evalSegCfg .mAR (0 :: lt2) (0 :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0R (bump1L lt2) (push0R Rt) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_4 (lt2 : List ℕ) (Rt : List ℕ) : + (evalSegCfg .mAR (1 :: lt2) (0 :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mEL (0 :: lt2) (push0R (push0R Rt)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_5 (l3 : ℕ) (lt2 : List ℕ) (Rt : List ℕ) : + (evalSegCfg .mAR ((l3 + 2) :: lt2) (0 :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mEL ((l3 + 1) :: lt2) (push0R (push0R Rt)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_6 (L : List ℕ) : + (evalSegCfg .mAR L (1 :: [])) [target_tm]⊢⁺ + evalSegCfg .mEL (bump1L (bump1L L)) (0 :: []) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_7 (L : List ℕ) (rt3 : List ℕ) : + (evalSegCfg .mAR L (1 :: (0 :: rt3))) [target_tm]⊢⁺ + evalSegCfg .mEL (bump1L (bump1L L)) (push0R rt3) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_8 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : + (evalSegCfg .mAR L (1 :: ((r3 + 1) :: rt3))) [target_tm]⊢⁺ + evalSegCfg .mEL (bump1L (bump1L L)) (0 :: (r3 :: rt3)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mAR_9 (L : List ℕ) (r3 : ℕ) (Rt : List ℕ) : + (evalSegCfg .mAR L ((r3 + 3) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR (bump1L L) (1 :: (r3 :: Rt)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_10 (L : List ℕ) : + (evalSegCfg .mA0R L []) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: L) (1 :: []) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_11 (rt1 : List ℕ) : + (evalSegCfg .mA0R [] (0 :: rt1)) [target_tm]⊢⁺ + evalSegCfg .mEL [] (0 :: (push0R rt1)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_12 (lt2 : List ℕ) (rt1 : List ℕ) : + (evalSegCfg .mA0R (0 :: lt2) (0 :: rt1)) [target_tm]⊢⁺ + evalSegCfg .mEL (0 :: lt2) (0 :: (push0R rt1)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_13 (l2 : ℕ) (lt2 : List ℕ) (rt1 : List ℕ) : + (evalSegCfg .mA0R ((l2 + 1) :: lt2) (0 :: rt1)) [target_tm]⊢⁺ + evalSegCfg .mEL ((l2 + 1) :: lt2) (0 :: (push0R rt1)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_14 (L : List ℕ) : + (evalSegCfg .mA0R L (1 :: [])) [target_tm]⊢⁺ + evalSegCfg .mEL (1 :: L) (0 :: []) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_15 (L : List ℕ) (rt3 : List ℕ) : + (evalSegCfg .mA0R L (1 :: (0 :: rt3))) [target_tm]⊢⁺ + evalSegCfg .mEL (1 :: L) (push0R rt3) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_16 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : + (evalSegCfg .mA0R L (1 :: ((r3 + 1) :: rt3))) [target_tm]⊢⁺ + evalSegCfg .mEL (1 :: L) (0 :: (r3 :: rt3)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_17 (L : List ℕ) : + (evalSegCfg .mA0R L (2 :: [])) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: (0 :: L)) [] := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_18 (L : List ℕ) (rt4 : List ℕ) : + (evalSegCfg .mA0R L (2 :: (0 :: rt4))) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: (0 :: L)) (0 :: rt4) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_19 (L : List ℕ) (r4 : ℕ) (rt4 : List ℕ) : + (evalSegCfg .mA0R L (2 :: ((r4 + 1) :: rt4))) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: (0 :: L)) ((r4 + 1) :: rt4) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mA0R_20 (L : List ℕ) (r3 : ℕ) (rt1 : List ℕ) : + (evalSegCfg .mA0R L ((r3 + 3) :: rt1)) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: L) (1 :: (r3 :: rt1)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_21 : + (evalSegCfg .mEL [] []) [target_tm]⊢⁺ + evalSegCfg .mA0R (0 :: []) [] := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_22_halt (rt2 : List ℕ) : + ∃ cfg_h, ((evalSegCfg .mEL [] (0 :: rt2)) [target_tm]⊢⁺ cfg_h) ∧ + (step target_tm cfg_h).isNone := by + have h1 : (evalSegCfg .mEL [] (0 :: rt2)) [target_tm]⊢⁺ (((1 : Fin 2) >> (encLeft [])) {{5}}> ((1 : Fin 2) >> (encRight rt2))) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + refine ⟨_, h1, ?_⟩ + simp [step, target_tm, Turing.ListBlank.head_cons] +lemma step_mEL_23 (rt2 : List ℕ) : + (evalSegCfg .mEL [] (1 :: rt2)) [target_tm]⊢⁺ + evalSegCfg .mA0R (0 :: []) (0 :: rt2) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_24 (r3 : ℕ) (rt2 : List ℕ) : + (evalSegCfg .mEL [] ((r3 + 2) :: rt2)) [target_tm]⊢⁺ + evalSegCfg .mA0R (0 :: []) ((r3 + 1) :: rt2) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_25 (lt1 : List ℕ) (R : List ℕ) : + (evalSegCfg .mEL (0 :: lt1) R) [target_tm]⊢⁺ + evalSegCfg .mAR lt1 (push0R (push0R R)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_26 (lt1 : List ℕ) (R : List ℕ) : + (evalSegCfg .mEL (1 :: lt1) R) [target_tm]⊢⁺ + evalSegCfg .mA0R lt1 (0 :: (push0R R)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute +lemma step_mEL_27 (l2 : ℕ) (lt1 : List ℕ) (R : List ℕ) : + (evalSegCfg .mEL ((l2 + 2) :: lt1) R) [target_tm]⊢⁺ + evalSegCfg .mAR (l2 :: lt1) (0 :: (push0R R)) := by + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_drain (L : List ℕ) (R : List ℕ) : + ∃ cfg', ((evalSegCfg .mAR L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + induction R generalizing L with + | nil => + exact ⟨evalCfg (.mAR, (bump1L L), (1 :: [])), step_mAR_1 L, Or.inl ⟨(.mAR, (bump1L L), (1 :: [])), trivial, rfl⟩⟩ + | cons hd Rt ih => + rcases hd with _ | _ | _ | r3 + · rcases L with _ | ⟨_ | l2, lt2⟩ + · exact ⟨evalCfg (.mEL, [], (0 :: (push0R Rt))), step_mAR_2 Rt, Or.inl ⟨(.mEL, [], (0 :: (push0R Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (bump1L lt2), (push0R Rt)), step_mAR_3 lt2 Rt, Or.inl ⟨(.mA0R, (bump1L lt2), (push0R Rt)), trivial, rfl⟩⟩ + · rcases l2 with _ | l3 + · exact ⟨evalCfg (.mEL, (0 :: lt2), (push0R (push0R Rt))), step_mAR_4 lt2 Rt, Or.inl ⟨(.mEL, (0 :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), step_mAR_5 l3 lt2 Rt, Or.inl ⟨(.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | r3, rt3⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: [])), step_mAR_6 L, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: [])), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (push0R rt3)), step_mAR_7 L rt3, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (push0R rt3)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), step_mAR_8 L r3 rt3, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ + · exact stepOut_trans (step_mAR_2_loop L Rt) (ih (0 :: bump1L L)) + · exact ⟨evalCfg (.mAR, (bump1L L), (1 :: (r3 :: Rt))), step_mAR_9 L r3 Rt, Or.inl ⟨(.mAR, (bump1L L), (1 :: (r3 :: Rt))), trivial, rfl⟩⟩ + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List ℕ) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAR => exact step_mAR_drain L R + | mA0R => + rcases R with _ | ⟨_ | r1, rt1⟩ + · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: [])), step_mA0R_10 L, Or.inl ⟨(.mAR, (0 :: L), (1 :: [])), trivial, rfl⟩⟩ + · rcases L with _ | ⟨_ | l2, lt2⟩ + · exact ⟨evalCfg (.mEL, [], (0 :: (push0R rt1))), step_mA0R_11 rt1, Or.inl ⟨(.mEL, [], (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (0 :: lt2), (0 :: (push0R rt1))), step_mA0R_12 lt2 rt1, Or.inl ⟨(.mEL, (0 :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), step_mA0R_13 l2 lt2 rt1, Or.inl ⟨(.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · rcases r1 with _ | r2 + · rcases rt1 with _ | ⟨_ | r3, rt3⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: [])), step_mA0R_14 L, Or.inl ⟨(.mEL, (1 :: L), (0 :: [])), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (push0R rt3)), step_mA0R_15 L rt3, Or.inl ⟨(.mEL, (1 :: L), (push0R rt3)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: (r3 :: rt3))), step_mA0R_16 L r3 rt3, Or.inl ⟨(.mEL, (1 :: L), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ + · rcases r2 with _ | r3 + · rcases rt1 with _ | ⟨_ | r4, rt4⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), []), step_mA0R_17 L, Or.inl ⟨(.mAR, (0 :: (0 :: L)), []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), (0 :: rt4)), step_mA0R_18 L rt4, Or.inl ⟨(.mAR, (0 :: (0 :: L)), (0 :: rt4)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), step_mA0R_19 L r4 rt4, Or.inl ⟨(.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: (r3 :: rt1))), step_mA0R_20 L r3 rt1, Or.inl ⟨(.mAR, (0 :: L), (1 :: (r3 :: rt1))), trivial, rfl⟩⟩ + | mEL => + rcases L with _ | ⟨_ | l1, lt1⟩ + · rcases R with _ | ⟨_ | r2, rt2⟩ + · exact ⟨evalCfg (.mA0R, (0 :: []), []), step_mEL_21, Or.inl ⟨(.mA0R, (0 :: []), []), trivial, rfl⟩⟩ + · rcases step_mEL_22_halt rt2 with ⟨cfg_h, hp, hh⟩; exact ⟨cfg_h, hp, Or.inr hh⟩ + · rcases r2 with _ | r3 + · exact ⟨evalCfg (.mA0R, (0 :: []), (0 :: rt2)), step_mEL_23 rt2, Or.inl ⟨(.mA0R, (0 :: []), (0 :: rt2)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (0 :: []), ((r3 + 1) :: rt2)), step_mEL_24 r3 rt2, Or.inl ⟨(.mA0R, (0 :: []), ((r3 + 1) :: rt2)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, lt1, (push0R (push0R R))), step_mEL_25 lt1 R, Or.inl ⟨(.mAR, lt1, (push0R (push0R R))), trivial, rfl⟩⟩ + · rcases l1 with _ | l2 + · exact ⟨evalCfg (.mA0R, lt1, (0 :: (push0R R))), step_mEL_26 lt1 R, Or.inl ⟨(.mA0R, lt1, (0 :: (push0R R))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (l2 :: lt1), (0 :: (push0R R))), step_mEL_27 l2 lt1 R, Or.inl ⟨(.mAR, (l2 :: lt1), (0 :: (push0R R))), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAR, .mA0R, .mEL], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inl segsL_nowhere_dense, + Or.inl segsL_nowhere_dense, + Or.inr segsR_boundary_aligned, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean new file mode 100644 index 00000000..01d14b03 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean @@ -0,0 +1,1401 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 0 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + try rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F04 | F05 | F07 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{F}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- ============================================================================ +-- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` +-- ============================================================================ + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by + have hb4 : bR % 4 + 1 < 4 := by omega + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega + rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] + execute 6 + +lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + execute 6 + +lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by + rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] + execute 9 + +lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), + encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] + execute 6 + +theorem stage1_step (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr ⟨L, [], rfl⟩⟩ + · rcases d with _ | _ | _ | _ | d' + · exact ⟨_, M0_zero L bR R', Or.inr ⟨L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · rcases mod4_cases bR with h0 | h1 | h2 | h3 + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ + · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + +-- ============================================================================ +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 3 + +lemma D_leaf_10 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, rD⟩⟩ := by + execute 4 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((0 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_zero : rD = encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 -> Leaf 10 bounces directly in 4 steps to cfg_M0 ((0, b₁) :: L') ((0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: L') = + (1 : Fin 2) >> (0 : Fin 2) >> ((([0] : List (Fin 2)) ^ (b₁ % 4)) +> encRight L') := by + rw [encTail_succ, encTail_zero, zero_pow_one_add (b₁ % 4), listblank_append_cons] + have hL0 : (0 : Fin 2) >> ((([0] : List (Fin 2)) ^ (b₁ % 4)) +> encRight L') = encTail ((0, b₁) :: L') := by + rw [encTail_zero, zero_pow_one_add (b₁ % 4), listblank_append_cons] + rw [hL] + refine ⟨cfg_M0 ((0, b₁) :: L') ((0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hL0, ← hrD_zero] + exact D_leaf_10 _ rD + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((0 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ +-- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) +-- ============================================================================ + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by + rw [w_peelInner_zero b S h] + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +-- Stage 3 P transitions +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + unfold P_cfg + rw [encRight_one_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 7 + +lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, + encRight_cons_eq_one_cons_encTail a b R_tail] + execute 11 + +-- Stage 3 F transitions on bit 0 +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 7 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 + +-- Stage 3 F transitions on bit 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 +lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 + +-- Pushdown predicate & bit-step combinators +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + refine Or.inr ⟨.F04, (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ + rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F04 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F05 => + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F07 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => + exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ + | F02 => + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + | F04 => + refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F05 => + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + | F07 => + refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | _ | a' + · -- a = 0 + have hw0 : w ((0, b) :: R_tail) = W_val := hw_ab + rcases R_tail with _ | ⟨r₂, rs⟩ + · -- R = [(0, b)] -> P_step_0_other + refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · -- P_step_0_rec -> calls Qz1 (r₂ :: rs) via ih_tail! + have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · -- b % 4 = 1 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 2 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 3 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = 1 + have hw1_eq : w ((1, b) :: R_tail) = W_val := hw_ab + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · -- P_step_1_rec: R_tail ≠ [] and b % 4 = 0 + obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p := P_step_1_rec L'' W_base b hb0 R_tail hne_tail + have hw_tail : w R_tail + 1 = w ((1, b) :: R_tail) := by + rw [w_cons_nonempty 1 b R_tail hne_tail] + have hb2 : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' (0 :: 1 :: W_base) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach1 := stepPlus_trans h_p h1 + have hc0 := C0_le_C1_succ s1 + have hw1_c0 : w R1 + C0 s1 ≤ W_val := by omega + rcases step_bit0 h_reach1 hR1 hw1_c0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · exact step_bit1 h2 hR2 hw2 ih_z + · -- P_step_1_other: R_tail = [] ∨ b % 4 ≠ 0 + have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have h_p := P_step_1_other L'' W_base b R_tail hcond + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hw1 : w R1 + 1 = w ((1, b) :: R_tail) := w_peelInner_one b R_tail hcond + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + rcases hQ0_R1 L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R2, hR2, hw2, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach2 := stepPlus_trans h_p h1 + have hc1 := C1_le_C0_succ s0 + have hw2_c1 : w R2 + C1 s0 ≤ W_val := by omega + exact step_bit1 h_reach2 hR2 hw2_c1 ih_z + · -- a = a' + 2 -> P_step_ge2 + have hw2_eq : w ((a' + 2, b) :: R_tail) = W_val := hw_ab + refine Or.inr ⟨.F00, (0, 0) :: (a', b) :: R_tail, by simp, ?_, + P_step_ge2 L'' W_base a' b R_tail⟩ + have hw_g := w_ge2 a' b R_tail + dsimp [C0]; omega + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +-- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 0) :: (0, 2) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall] + rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 0, + encRight_cons_simp 0 2, encRight_tailAsRight, encTail_zero 0] + execute 15 +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by + cases s with + | F00 => exact ⟨_, _, F00_exit L'' R⟩ + | F01 => exact ⟨_, _, F01_exit L'' R⟩ + | F02 => exact ⟨_, _, F02_exit L'' R⟩ + | F04 => exact ⟨_, _, F04_exit L'' R⟩ + | F05 => exact ⟨_, _, F05_exit L'' R⟩ + | F07 => exact ⟨_, _, F07_exit L'' R⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, _, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · obtain ⟨L_out, R_out', h2⟩ := F_exit_all s L'' R_out + exact ⟨cfg_M0 L_out R_out', stepPlus_trans h1 h2, Or.inl ⟨.M0, L_out, R_out', rfl⟩⟩ + +-- ============================================================================ +-- Closure & Main Theorem +-- ============================================================================ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step L R + rcases hout₁ with hM₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +-- ============================================================================ +-- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield +-- ============================================================================ + +lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} + (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := + stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ +lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (0, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_0_rec L'' W 0 rfl (List.replicate k (0, 0) ++ R_tail) hne) + (ih (0 :: 1 :: W)) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ +lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (1, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_1_rec L'' W 0 rfl (List.replicate k (1, 0) ++ R_tail) hne) + (ih (0 :: 0 :: 1 :: W)) + +/-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ +lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ + cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by + rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R + have h0 : 0 % 4 = 0 := rfl + have hL_enc : encTail ((0, 0) :: (0, 0) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, h0, encRight_cons_eq_one_cons_encTail, encTail_zero, h0, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL_enc] + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + +/-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ +lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* + cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by + induction k generalizing R with + | zero => + simp only [Nat.mul_zero, List.replicate_zero, List.nil_append, + Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + rw [Function.iterate_succ_apply] + have h_rep : List.replicate (2 * (k + 1)) (0, 0) ++ L_rest = + (0, 0) :: (0, 0) :: (List.replicate (2 * k) (0, 0) ++ L_rest) := by + have h2 : 2 * (k + 1) = 2 * k + 2 := by omega + rw [h2] + rfl + rw [h_rep] + have hne : List.replicate (2 * k) (0, 0) ++ L_rest ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hL + exact stepPlus_stepStar_trans + (D_pop_double_zero 2 (by decide) (List.replicate (2 * k) (0, 0) ++ L_rest) R hne) + (ih ((0, 2) :: tailAsRight R)) + +/-- Stage 2 empty-left-stack return to `cfg_M0`. -/ +lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ +theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), + M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ +theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), + M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ +theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), + M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ +theorem mode_M0_nil_nil_nonhalting : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl⟩⟩ + +/-- Refined reachable stack subset for Holdout `#223`: canonical `evalStackCfg m L R` + configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ +def ValidStack223 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +theorem validStack223_subset_isInStackSystem : + ∀ cfg, ValidStack223 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +theorem init_reaches_validStack223 : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack223 cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, + ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +theorem cfg_M0_nil_nil_reaches_validStack223 : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack223 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +theorem stack_system_steps_to_validStack223 : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack223 cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg hcfg + obtain ⟨cfg₁, h₁, hout⟩ := stack_system_closed cfg hcfg + rcases hout with ⟨m, L, R, rfl⟩ | hhalt + · cases m with + | M0 => + rcases L with _ | ⟨pL, L'⟩ + · rcases R with _ | ⟨pR, R'⟩ + · obtain ⟨cfg₂, h₂, hvalid₂⟩ := cfg_M0_nil_nil_reaches_validStack223 + exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hvalid₂⟩ + · exact ⟨evalStackCfg .M0 [] (pR :: R'), h₁, + Or.inl ⟨.M0, [], pR :: R', rfl, Or.inr (by simp)⟩⟩ + · exact ⟨evalStackCfg .M0 (pL :: L') R, h₁, + Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ + · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ + +theorem validStack223_step_closed : + ∀ cfg, ValidStack223 cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack223 cfg' ∨ (step target_tm cfg').isNone) := + fun cfg hvalid => + stack_system_steps_to_validStack223 cfg (validStack223_subset_isInStackSystem cfg hvalid) + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` + when `bR % 4 < 3`. -/ +theorem mode_M0_head_three_lt3_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + ValidStack223 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R'), + M0_three_lt3 L bR hb R', + ⟨.M0, (0, 0) :: tailAsRight L, pushZeroSep (bR % 4 + 1) R', rfl, Or.inl (by simp)⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` + when `bR % 4 = 3`. -/ +theorem mode_M0_head_three_eq3_nil_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ + ValidStack223 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) [], + M0_three_eq3_nil L bR hb, + ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ + +/-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ +lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : + (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := + RD_eq_encTail_one c hc R + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ +theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : + ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ + ValidStack223 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil [(0, b₁)]) (D_singleton_zero_return 0 (by decide) b₁ []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +/-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ +lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + exact ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((0 : Fin 2) >> rD), + D_leaf_11 _ rD, F_halt_on_one _ _⟩ + +/-- Stage 2 halting counterexample family in `ValidStack223` (`R = []`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack223` and halts + in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack223_M0_left_ge2_nil_halts + (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : + ValidStack223 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', [], rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' [] + exact ⟨cfg', stepPlus_trans (M0_nil ((a₁' + 2, b₁) :: L')) hD, hhalt⟩ + +/-- Stage 2 halting counterexample family in `ValidStack223` (`R = (0, bR) :: R'`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack223` + and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack223_M0_left_ge2_zero_halts + (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : + ValidStack223 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', (0, bR) :: R', rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' (peelSep bR R') + exact ⟨cfg', stepPlus_trans (M0_zero ((a₁' + 2, b₁) :: L') bR R') hD, hhalt⟩ + +/-- Multi-phase halting counterexample family in `ValidStack223` (`R = (3, 3) :: (d₂, b₂) :: R''`): + `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 + via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, + and halts via `D_head_ge2_halts`. -/ +theorem counterexample_validStack223_M0_three_eq3_cons_halts + (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : + ValidStack223 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (0, 0) :: (a₁' + 2, b₁) :: L', (3, 3) :: (d₂, b₂) :: R'', + rfl, Or.inl (by simp)⟩, ?_⟩ + have h1 := M0_three_eq3_cons ((0, 0) :: (a₁' + 2, b₁) :: L') 3 rfl d₂ b₂ R'' + have h2 := D_pop_double_zero 0 (by decide) ((a₁' + 2, b₁) :: L') + ((0, 3) :: (d₂, b₂) :: R'') (by simp) + obtain ⟨cfg', h3, hhalt⟩ := D_head_ge2_halts 2 a₁' b₁ L' + ((0, 0) :: tailAsRight ((0, 3) :: (d₂, b₂) :: R'')) + exact ⟨cfg', stepPlus_trans (stepPlus_trans h1 h2) h3, hhalt⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean new file mode 100644 index 00000000..2f58f4da --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean @@ -0,0 +1,1633 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 1, Stmt.write 0 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + try rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 + | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{B}} ((0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{C}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) + | .F10, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- ============================================================================ +-- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` +-- ============================================================================ + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by + have hb4 : bR % 4 + 1 < 4 := by omega + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega + rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] + execute 6 + +lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + execute 6 + +lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by + rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] + execute 9 + +lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), + encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] + execute 6 + +theorem stage1_step (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr ⟨L, [], rfl⟩⟩ + · rcases d with _ | _ | _ | _ | d' + · exact ⟨_, M0_zero L bR R', Or.inr ⟨L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · rcases mod4_cases bR with h0 | h1 | h2 | h3 + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ + · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + +-- ============================================================================ +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 3 + +lemma D_leaf_10000 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 7 + +lemma D_leaf_10001 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 7 + +lemma D_leaf_1001 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_101 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 5 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(1, b₁)] -> Leaf 10000 + have hL : encTail [(1, b₁)] = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((0, 1) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero 1 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_10000 default rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0 -> Leaf 101 + rcases a₂ with _ | a₂' + · -- a₂ = 0 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(1, b₁), (0, b₂)] = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_101 default rD + · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_101 _ rD + · -- a₂ = a₂' + 1 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂' + 1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_101 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 1001 -> cfg_D 0 ((a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 0 ((a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨0, (a₂, b₂) :: L'', (0, 0) :: (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + rw [encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_1001 (encTail ((a₂, b₂) :: L'')) rD + · -- b₁ % 4 = 2 -> Leaf 10001 -> cfg_D 3 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 3 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨3, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_10001 (encTail ((a₂, b₂) :: L'')) rD + · -- b₁ % 4 = 3 -> Leaf 10000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + encTail_zero 1 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_10000 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) rD + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ +-- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) +-- ============================================================================ + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 2 | .F04 => 1 | .F05 => 0 | .F06 => 3 + | .F07 => 1 | .F08 => 4 | .F09 => 2 | .F10 => 3 | .F11 => 3 | .F12 => 4 | .F13 => 4 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 1 | .F06 => 2 + | .F07 => 0 | .F08 => 3 | .F09 => 3 | .F10 => 4 | .F11 => 4 | .F12 => 3 | .F13 => 5 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by + rw [w_peelInner_zero b S h] + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +-- Stage 3 P transitions +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + unfold P_cfg + rw [encRight_one_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 7 + +lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, + encRight_cons_eq_one_cons_encTail a b R_tail] + execute 11 + +-- Stage 3 F transitions on bit 0 +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W R := by dsimp only [F_cfg]; execute 3 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 +lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 +lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 + +-- Stage 3 F transitions on bit 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 +lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F11 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 +lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ + +-- Pushdown predicate & bit-step combinators +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + refine Or.inr ⟨.F03, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ + rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => + exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F05 => + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F06 => + exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + | F07 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F08 => + refine Or.inr ⟨.F04, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F09 => + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + | F10 => + exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + | F11 => + refine Or.inr ⟨.F03, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F12 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F13 => + refine Or.inr ⟨.F03, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => + exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ + | F02 => + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + | F03 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F03_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F04 => + refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F05 => + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + | F06 => + refine Or.inr ⟨.F09, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F07 => + refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F08 => + exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + | F09 => + exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ + | F10 => + exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + | F11 => + exact Or.inl ⟨F_cfg .F11 L'' (1 :: W_out) R₁, h_reach, F11_bit1_halt L'' W_out R₁⟩ + | F12 => + refine Or.inr ⟨.F00, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F13 => + exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | _ | a' + · -- a = 0 + have hw0 : w ((0, b) :: R_tail) = W_val := hw_ab + rcases R_tail with _ | ⟨r₂, rs⟩ + · -- R = [(0, b)] -> P_step_0_other + refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · -- P_step_0_rec -> calls Qz1 (r₂ :: rs) via ih_tail! + have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · -- b % 4 = 1 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 2 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 3 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = 1 + have hw1_eq : w ((1, b) :: R_tail) = W_val := hw_ab + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · -- P_step_1_rec: R_tail ≠ [] and b % 4 = 0 + obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p := P_step_1_rec L'' W_base b hb0 R_tail hne_tail + have hw_tail : w R_tail + 1 = w ((1, b) :: R_tail) := by + rw [w_cons_nonempty 1 b R_tail hne_tail] + have hb2 : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' (0 :: 1 :: W_base) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach1 := stepPlus_trans h_p h1 + have hc0 := C0_le_C1_succ s1 + have hw1_c0 : w R1 + C0 s1 ≤ W_val := by omega + rcases step_bit0 h_reach1 hR1 hw1_c0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · exact step_bit1 h2 hR2 hw2 ih_z + · -- P_step_1_other: R_tail = [] ∨ b % 4 ≠ 0 + have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have h_p := P_step_1_other L'' W_base b R_tail hcond + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hw1 : w R1 + 1 = w ((1, b) :: R_tail) := w_peelInner_one b R_tail hcond + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + rcases hQ0_R1 L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R2, hR2, hw2, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach2 := stepPlus_trans h_p h1 + have hc1 := C1_le_C0_succ s0 + have hw2_c1 : w R2 + C1 s0 ≤ W_val := by omega + exact step_bit1 h_reach2 hR2 hw2_c1 ih_z + · -- a = a' + 2 -> P_step_ge2 + have hw2_eq : w ((a' + 2, b) :: R_tail) = W_val := hw_ab + refine Or.inr ⟨.F00, (0, 0) :: (a', b) :: R_tail, by simp, ?_, + P_step_ge2 L'' W_base a' b R_tail⟩ + have hw_g := w_ge2 a' b R_tail + dsimp [C0]; omega + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +-- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 2]; execute 6 +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 1]; execute 5 +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +lemma F06_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +lemma F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 +lemma F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +lemma F10_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 +lemma F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 0]; execute 6 +lemma F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 +lemma F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 3]; execute 6 + +lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by + cases s with + | F00 => exact ⟨_, _, F00_exit L'' R⟩ + | F01 => exact ⟨_, _, F01_exit L'' R⟩ + | F02 => exact ⟨_, _, F02_exit L'' R⟩ + | F03 => exact ⟨_, _, F03_exit L'' R⟩ + | F04 => exact ⟨_, _, F04_exit L'' R⟩ + | F05 => exact ⟨_, _, F05_exit L'' R⟩ + | F06 => exact ⟨_, _, F06_exit L'' R⟩ + | F07 => exact ⟨_, _, F07_exit L'' R⟩ + | F08 => exact ⟨_, _, F08_exit L'' R⟩ + | F09 => exact ⟨_, _, F09_exit L'' R⟩ + | F10 => exact ⟨_, _, F10_exit L'' R⟩ + | F11 => exact ⟨_, _, F11_exit L'' R⟩ + | F12 => exact ⟨_, _, F12_exit L'' R⟩ + | F13 => exact ⟨_, _, F13_exit L'' R⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, _, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · obtain ⟨L_out, R_out', h2⟩ := F_exit_all s L'' R_out + exact ⟨cfg_M0 L_out R_out', stepPlus_trans h1 h2, Or.inl ⟨.M0, L_out, R_out', rfl⟩⟩ + +-- ============================================================================ +-- Closure & Main Theorem +-- ============================================================================ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step L R + rcases hout₁ with hM₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +-- ============================================================================ +-- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield +-- ============================================================================ + +lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} + (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := + stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ +lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (0, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_0_rec L'' W 0 rfl (List.replicate k (0, 0) ++ R_tail) hne) + (ih (0 :: 1 :: W)) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ +lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (1, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_1_rec L'' W 0 rfl (List.replicate k (1, 0) ++ R_tail) hne) + (ih (0 :: 0 :: 1 :: W)) + +/-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ +lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ + cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by + rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R + have h0 : 0 % 4 = 0 := rfl + have hL_enc : encTail ((0, 0) :: (0, 0) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, h0, encRight_cons_eq_one_cons_encTail, encTail_zero, h0, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL_enc] + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + +/-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ +lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* + cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by + induction k generalizing R with + | zero => + simp only [Nat.mul_zero, List.replicate_zero, List.nil_append, + Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + rw [Function.iterate_succ_apply] + have h_rep : List.replicate (2 * (k + 1)) (0, 0) ++ L_rest = + (0, 0) :: (0, 0) :: (List.replicate (2 * k) (0, 0) ++ L_rest) := by + have h2 : 2 * (k + 1) = 2 * k + 2 := by omega + rw [h2] + rfl + rw [h_rep] + have hne : List.replicate (2 * k) (0, 0) ++ L_rest ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hL + exact stepPlus_stepStar_trans + (D_pop_double_zero 2 (by decide) (List.replicate (2 * k) (0, 0) ++ L_rest) R hne) + (ih ((0, 2) :: tailAsRight R)) + +/-- Stage 2 empty-left-stack return to `cfg_M0`. -/ +lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ +theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), + M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ +theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), + M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ +theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), + M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ +theorem mode_M0_nil_nil_nonhalting : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl⟩⟩ + +/-- Refined reachable stack subset for Holdout `#325`: canonical `evalStackCfg m L R` + configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ +def ValidStack325 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +theorem validStack325_subset_isInStackSystem : + ∀ cfg, ValidStack325 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +theorem init_reaches_validStack325 : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack325 cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, + ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +theorem cfg_M0_nil_nil_reaches_validStack325 : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack325 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +theorem stack_system_steps_to_validStack325 : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack325 cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg hcfg + obtain ⟨cfg₁, h₁, hout⟩ := stack_system_closed cfg hcfg + rcases hout with ⟨m, L, R, rfl⟩ | hhalt + · cases m with + | M0 => + rcases L with _ | ⟨pL, L'⟩ + · rcases R with _ | ⟨pR, R'⟩ + · obtain ⟨cfg₂, h₂, hvalid₂⟩ := cfg_M0_nil_nil_reaches_validStack325 + exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hvalid₂⟩ + · exact ⟨evalStackCfg .M0 [] (pR :: R'), h₁, + Or.inl ⟨.M0, [], pR :: R', rfl, Or.inr (by simp)⟩⟩ + · exact ⟨evalStackCfg .M0 (pL :: L') R, h₁, + Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ + · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ + +theorem validStack325_step_closed : + ∀ cfg, ValidStack325 cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack325 cfg' ∨ (step target_tm cfg').isNone) := + fun cfg hvalid => + stack_system_steps_to_validStack325 cfg (validStack325_subset_isInStackSystem cfg hvalid) + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` + when `bR % 4 < 3`. -/ +theorem mode_M0_head_three_lt3_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + ValidStack325 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R'), + M0_three_lt3 L bR hb R', + ⟨.M0, (0, 0) :: tailAsRight L, pushZeroSep (bR % 4 + 1) R', rfl, Or.inl (by simp)⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` + when `bR % 4 = 3`. -/ +theorem mode_M0_head_three_eq3_nil_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ + ValidStack325 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) [], + M0_three_eq3_nil L bR hb, + ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ + +/-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ +lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : + (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := + RD_eq_encTail_one c hc R + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ +theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : + ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ + ValidStack325 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil [(0, b₁)]) (D_singleton_zero_return 0 (by decide) b₁ []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +/-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ +lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + exact ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, F_halt_on_one _ _⟩ + +/-- Stage 2 halting counterexample family in `ValidStack325` (`R = []`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack325` and halts + in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack325_M0_left_ge2_nil_halts + (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : + ValidStack325 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', [], rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' [] + exact ⟨cfg', stepPlus_trans (M0_nil ((a₁' + 2, b₁) :: L')) hD, hhalt⟩ + +/-- Stage 2 halting counterexample family in `ValidStack325` (`R = (0, bR) :: R'`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack325` + and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack325_M0_left_ge2_zero_halts + (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : + ValidStack325 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', (0, bR) :: R', rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' (peelSep bR R') + exact ⟨cfg', stepPlus_trans (M0_zero ((a₁' + 2, b₁) :: L') bR R') hD, hhalt⟩ + +/-- Multi-phase halting counterexample family in `ValidStack325` (`R = (3, 3) :: (d₂, b₂) :: R''`): + `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 + via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, + and halts via `D_head_ge2_halts`. -/ +theorem counterexample_validStack325_M0_three_eq3_cons_halts + (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : + ValidStack325 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (0, 0) :: (a₁' + 2, b₁) :: L', (3, 3) :: (d₂, b₂) :: R'', + rfl, Or.inl (by simp)⟩, ?_⟩ + have h1 := M0_three_eq3_cons ((0, 0) :: (a₁' + 2, b₁) :: L') 3 rfl d₂ b₂ R'' + have h2 := D_pop_double_zero 0 (by decide) ((a₁' + 2, b₁) :: L') + ((0, 3) :: (d₂, b₂) :: R'') (by simp) + obtain ⟨cfg', h3, hhalt⟩ := D_head_ge2_halts 2 a₁' b₁ L' + ((0, 0) :: tailAsRight ((0, 3) :: (d₂, b₂) :: R'')) + exact ⟨cfg', stepPlus_trans (stepPlus_trans h1 h2) h3, hhalt⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean new file mode 100644 index 00000000..6d433b25 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean @@ -0,0 +1,1625 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 0 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + try rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 + | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{B}} ((0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{C}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) + | .F10, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- ============================================================================ +-- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` +-- ============================================================================ + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by + have hb4 : bR % 4 + 1 < 4 := by omega + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega + rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] + execute 6 + +lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + execute 6 + +lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by + rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] + execute 9 + +lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), + encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] + execute 6 + +theorem stage1_step (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr ⟨L, [], rfl⟩⟩ + · rcases d with _ | _ | _ | _ | d' + · exact ⟨_, M0_zero L bR R', Or.inr ⟨L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · rcases mod4_cases bR with h0 | h1 | h2 | h3 + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ + · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ + · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + +-- ============================================================================ +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 3 + +lemma D_leaf_1000 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_1001 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_101 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 3 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(1, b₁)] -> Leaf 1000 + have hL : encTail [(1, b₁)] = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_1000 default rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0 -> Leaf 101 + rcases a₂ with _ | a₂' + · -- a₂ = 0 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(1, b₁), (0, b₂)] = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_101 default rD + · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_101 _ rD + · -- a₂ = a₂' + 1 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂' + 1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_101 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 1001 -> cfg_D 2 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_1001 (encTail ((a₂, b₂) :: L'')) rD + · -- b₁ % 4 = 2 -> Leaf 1000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_1000 (encRight ((a₂, b₂) :: L'')) rD + · -- b₁ % 4 = 3 -> Leaf 1000 -> cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₂, b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb3] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_1000 ((0 : Fin 2) >> encRight ((a₂, b₂) :: L'')) rD + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ +-- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) +-- ============================================================================ + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 2 | .F04 => 1 | .F05 => 0 | .F06 => 3 + | .F07 => 1 | .F08 => 4 | .F09 => 2 | .F10 => 3 | .F11 => 3 | .F12 => 4 | .F13 => 4 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 1 | .F06 => 2 + | .F07 => 0 | .F08 => 3 | .F09 => 3 | .F10 => 4 | .F11 => 4 | .F12 => 3 | .F13 => 5 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by + rw [w_peelInner_zero b S h] + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +-- Stage 3 P transitions +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + unfold P_cfg + rw [encRight_one_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 7 + +lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, + encRight_cons_eq_one_cons_encTail a b R_tail] + execute 11 + +-- Stage 3 F transitions on bit 0 +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W R := by dsimp only [F_cfg]; execute 3 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 +lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 +lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 + +-- Stage 3 F transitions on bit 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 +lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W R := by dsimp only [F_cfg]; execute 1 +lemma F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F11 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 +lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ + +-- Pushdown predicate & bit-step combinators +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ + rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => + exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F05 => + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F06 => + exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + | F07 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F08 => + refine Or.inr ⟨.F04, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F09 => + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + | F10 => + exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + | F11 => + refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F12 => + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + | F13 => + refine Or.inr ⟨.F00, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => + exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ + | F02 => + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + | F03 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F03_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F04 => + refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F05 => + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + | F06 => + refine Or.inr ⟨.F09, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F07 => + refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F08 => + exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + | F09 => + exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ + | F10 => + exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + | F11 => + exact Or.inl ⟨F_cfg .F11 L'' (1 :: W_out) R₁, h_reach, F11_bit1_halt L'' W_out R₁⟩ + | F12 => + refine Or.inr ⟨.F00, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit1 L'' W_out R₁)⟩ + rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega + | F13 => + exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | _ | a' + · -- a = 0 + have hw0 : w ((0, b) :: R_tail) = W_val := hw_ab + rcases R_tail with _ | ⟨r₂, rs⟩ + · -- R = [(0, b)] -> P_step_0_other + refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · -- P_step_0_rec -> calls Qz1 (r₂ :: rs) via ih_tail! + have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · -- b % 4 = 1 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 2 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- b % 4 = 3 -> P_step_0_other + have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = 1 + have hw1_eq : w ((1, b) :: R_tail) = W_val := hw_ab + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · -- P_step_1_rec: R_tail ≠ [] and b % 4 = 0 + obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p := P_step_1_rec L'' W_base b hb0 R_tail hne_tail + have hw_tail : w R_tail + 1 = w ((1, b) :: R_tail) := by + rw [w_cons_nonempty 1 b R_tail hne_tail] + have hb2 : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' (0 :: 1 :: W_base) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach1 := stepPlus_trans h_p h1 + have hc0 := C0_le_C1_succ s1 + have hw1_c0 : w R1 + C0 s1 ≤ W_val := by omega + rcases step_bit0 h_reach1 hR1 hw1_c0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · exact step_bit1 h2 hR2 hw2 ih_z + · -- P_step_1_other: R_tail = [] ∨ b % 4 ≠ 0 + have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have h_p := P_step_1_other L'' W_base b R_tail hcond + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hw1 : w R1 + 1 = w ((1, b) :: R_tail) := w_peelInner_one b R_tail hcond + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + rcases hQ0_R1 L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R2, hR2, hw2, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have h_reach2 := stepPlus_trans h_p h1 + have hc1 := C1_le_C0_succ s0 + have hw2_c1 : w R2 + C1 s0 ≤ W_val := by omega + exact step_bit1 h_reach2 hR2 hw2_c1 ih_z + · -- a = a' + 2 -> P_step_ge2 + have hw2_eq : w ((a' + 2, b) :: R_tail) = W_val := hw_ab + refine Or.inr ⟨.F00, (0, 0) :: (a', b) :: R_tail, by simp, ?_, + P_step_ge2 L'' W_base a' b R_tail⟩ + have hw_g := w_ge2 a' b R_tail + dsimp [C0]; omega + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +-- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 3 +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 1]; execute 5 +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +lemma F06_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +lemma F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 +lemma F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +lemma F10_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 +lemma F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 3 +lemma F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 +lemma F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 3 + +lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by + cases s with + | F00 => exact ⟨_, _, F00_exit L'' R⟩ + | F01 => exact ⟨_, _, F01_exit L'' R⟩ + | F02 => exact ⟨_, _, F02_exit L'' R⟩ + | F03 => exact ⟨_, _, F03_exit L'' R⟩ + | F04 => exact ⟨_, _, F04_exit L'' R⟩ + | F05 => exact ⟨_, _, F05_exit L'' R⟩ + | F06 => exact ⟨_, _, F06_exit L'' R⟩ + | F07 => exact ⟨_, _, F07_exit L'' R⟩ + | F08 => exact ⟨_, _, F08_exit L'' R⟩ + | F09 => exact ⟨_, _, F09_exit L'' R⟩ + | F10 => exact ⟨_, _, F10_exit L'' R⟩ + | F11 => exact ⟨_, _, F11_exit L'' R⟩ + | F12 => exact ⟨_, _, F12_exit L'' R⟩ + | F13 => exact ⟨_, _, F13_exit L'' R⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, _, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · obtain ⟨L_out, R_out', h2⟩ := F_exit_all s L'' R_out + exact ⟨cfg_M0 L_out R_out', stepPlus_trans h1 h2, Or.inl ⟨.M0, L_out, R_out', rfl⟩⟩ + +-- ============================================================================ +-- Closure & Main Theorem +-- ============================================================================ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step L R + rcases hout₁ with hM₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +-- ============================================================================ +-- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield +-- ============================================================================ + +lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} + (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := + stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ +lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (0, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_0_rec L'' W 0 rfl (List.replicate k (0, 0) ++ R_tail) hne) + (ih (0 :: 1 :: W)) + +/-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs + in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ +lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* + P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by + induction k generalizing W with + | zero => + simp only [List.replicate_zero, List.nil_append, Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + simp only [List.replicate_succ, List.cons_append, Function.iterate_succ_apply] + have hne : List.replicate k (1, 0) ++ R_tail ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hR + exact stepPlus_stepStar_trans + (P_step_1_rec L'' W 0 rfl (List.replicate k (1, 0) ++ R_tail) hne) + (ih (0 :: 0 :: 1 :: W)) + +/-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ +lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ + cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by + rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R + have h0 : 0 % 4 = 0 := rfl + have hL_enc : encTail ((0, 0) :: (0, 0) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, h0, encRight_cons_eq_one_cons_encTail, encTail_zero, h0, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL_enc] + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + +/-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ +lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : + (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* + cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by + induction k generalizing R with + | zero => + simp only [Nat.mul_zero, List.replicate_zero, List.nil_append, + Function.iterate_zero, id_eq] + exact ⟨0, rfl⟩ + | succ k ih => + rw [Function.iterate_succ_apply] + have h_rep : List.replicate (2 * (k + 1)) (0, 0) ++ L_rest = + (0, 0) :: (0, 0) :: (List.replicate (2 * k) (0, 0) ++ L_rest) := by + have h2 : 2 * (k + 1) = 2 * k + 2 := by omega + rw [h2] + rfl + rw [h_rep] + have hne : List.replicate (2 * k) (0, 0) ++ L_rest ≠ [] := + List.append_ne_nil_of_right_ne_nil _ hL + exact stepPlus_stepStar_trans + (D_pop_double_zero 2 (by decide) (List.replicate (2 * k) (0, 0) ++ L_rest) R hne) + (ih ((0, 2) :: tailAsRight R)) + +/-- Stage 2 empty-left-stack return to `cfg_M0`. -/ +lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ +theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), + M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ +theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), + M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ +theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), + M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ +theorem mode_M0_nil_nil_nonhalting : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ + IsInStackSystem cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl⟩⟩ + +/-- Refined reachable stack subset for Holdout `#304`: canonical `evalStackCfg m L R` + configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ +def ValidStack304 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +theorem validStack304_subset_isInStackSystem : + ∀ cfg, ValidStack304 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +theorem init_reaches_validStack304 : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack304 cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, + ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +theorem cfg_M0_nil_nil_reaches_validStack304 : + ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack304 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +theorem stack_system_steps_to_validStack304 : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack304 cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg hcfg + obtain ⟨cfg₁, h₁, hout⟩ := stack_system_closed cfg hcfg + rcases hout with ⟨m, L, R, rfl⟩ | hhalt + · cases m with + | M0 => + rcases L with _ | ⟨pL, L'⟩ + · rcases R with _ | ⟨pR, R'⟩ + · obtain ⟨cfg₂, h₂, hvalid₂⟩ := cfg_M0_nil_nil_reaches_validStack304 + exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hvalid₂⟩ + · exact ⟨evalStackCfg .M0 [] (pR :: R'), h₁, + Or.inl ⟨.M0, [], pR :: R', rfl, Or.inr (by simp)⟩⟩ + · exact ⟨evalStackCfg .M0 (pL :: L') R, h₁, + Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ + · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ + +theorem validStack304_step_closed : + ∀ cfg, ValidStack304 cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (ValidStack304 cfg' ∨ (step target_tm cfg').isNone) := + fun cfg hvalid => + stack_system_steps_to_validStack304 cfg (validStack304_subset_isInStackSystem cfg hvalid) + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` + when `bR % 4 < 3`. -/ +theorem mode_M0_head_three_lt3_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + ValidStack304 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R'), + M0_three_lt3 L bR hb R', + ⟨.M0, (0, 0) :: tailAsRight L, pushZeroSep (bR % 4 + 1) R', rfl, Or.inl (by simp)⟩⟩ + +/-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` + when `bR % 4 = 3`. -/ +theorem mode_M0_head_three_eq3_nil_nonhalting + (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : + ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ + ValidStack304 cfg' := + ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) [], + M0_three_eq3_nil L bR hb, + ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ + +/-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ +lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : + (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := + RD_eq_encTail_one c hc R + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL, cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + +/-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ +theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : + ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ + ValidStack304 cfg' := + ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), + stepPlus_trans (M0_nil [(0, b₁)]) (D_singleton_zero_return 0 (by decide) b₁ []), + ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ + +/-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ +lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + exact ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, F_halt_on_one _ _⟩ + +/-- Stage 2 halting counterexample family in `ValidStack304` (`R = []`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack304` and halts + in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack304_M0_left_ge2_nil_halts + (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : + ValidStack304 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', [], rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' [] + exact ⟨cfg', stepPlus_trans (M0_nil ((a₁' + 2, b₁) :: L')) hD, hhalt⟩ + +/-- Stage 2 halting counterexample family in `ValidStack304` (`R = (0, bR) :: R'`): any + `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack304` + and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ +theorem counterexample_validStack304_M0_left_ge2_zero_halts + (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : + ValidStack304 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (a₁' + 2, b₁) :: L', (0, bR) :: R', rfl, Or.inl (by simp)⟩, ?_⟩ + obtain ⟨cfg', hD, hhalt⟩ := D_head_ge2_halts 0 a₁' b₁ L' (peelSep bR R') + exact ⟨cfg', stepPlus_trans (M0_zero ((a₁' + 2, b₁) :: L') bR R') hD, hhalt⟩ + +/-- Multi-phase halting counterexample family in `ValidStack304` (`R = (3, 3) :: (d₂, b₂) :: R''`): + `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 + via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, + and halts via `D_head_ge2_halts`. -/ +theorem counterexample_validStack304_M0_three_eq3_cons_halts + (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : + ValidStack304 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) ∧ + ∃ cfg', ((evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') + ((3, 3) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg') ∧ + (step target_tm cfg').isNone = true := by + refine ⟨⟨.M0, (0, 0) :: (a₁' + 2, b₁) :: L', (3, 3) :: (d₂, b₂) :: R'', + rfl, Or.inl (by simp)⟩, ?_⟩ + have h1 := M0_three_eq3_cons ((0, 0) :: (a₁' + 2, b₁) :: L') 3 rfl d₂ b₂ R'' + have h2 := D_pop_double_zero 0 (by decide) ((a₁' + 2, b₁) :: L') + ((0, 3) :: (d₂, b₂) :: R'') (by simp) + obtain ⟨cfg', h3, hhalt⟩ := D_head_ge2_halts 2 a₁' b₁ L' + ((0, 0) :: tailAsRight ((0, 3) :: (d₂, b₂) :: R'')) + exact ⟨cfg', stepPlus_trans (stepPlus_trans h1 h2) h3, hhalt⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean new file mode 100644 index 00000000..b7a1069c --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean @@ -0,0 +1,1581 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 0 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{A}} ((0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) + | .F08, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 5 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 (for #14: F0 = 0LA) + have h100 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 2 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · have hL : encTail [(1, b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h100 default + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0 + rcases a₂ with _ | a₂' + · -- a₂ = 0 + by_cases h_rec2 : L'' ≠ [] ∧ b₂ % 4 = 0 + · obtain ⟨hne2, hb20⟩ := h_rec2 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, hb20, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 3 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨3, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + execute 5 + · have hcond2 : L'' = [] ∨ b₂ % 4 ≠ 0 := by + rcases L'' with _ | ⟨_, _⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec2 ⟨by simp, h0⟩) + have hz2 : encTail ((0, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b₂ L'') := by + have hl := encRight_zero_peelInner b₂ L'' hcond2 + rw [encRight_cons_eq_one_cons_encTail 0 b₂ L''] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg ListBlank.tail hl + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b₂ L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, hz2] + rfl + rw [hL] + refine ⟨cfg_M0 (peelSep b₂ L'') ((0, 1) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + have hsep : encTail (peelSep b₂ L'') = (0 : Fin 2) >> encTail (peelInner b₂ L'') := by + have hz0 : encTail ((0, b₂) :: L'') = (0 : Fin 2) >> encTail (peelSep b₂ L'') := by + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b₂ % 4), listblank_append_cons, + ← encTail_peelSep b₂ ((a₃, b₃) :: L''')] + rw [hz0] at hz2 + simpa only [Turing.ListBlank.tail_cons] using congrArg ListBlank.tail hz2 + rw [cfg_M0_eq, hsep, encTail_zero 1 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using (by execute 5 : + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b₂ L'')) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> encTail (peelInner b₂ L''), + (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩) + · -- a₂ = a₂' + 1 + have h1011 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 6 + rcases a₂' with _ | a₂'' + · -- a₂ = 1: split b₂ % 4 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h1011 ((0 : Fin 2) >> encRight L'') + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') + · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(1, b₁), (1, b₂)] = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h1011 default + · have hL : encTail ((1, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((1, 0) :: (1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + have hpeel2 : ∀ (tL tP : ListBlank (Fin 2)), + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + intro tL tP; execute 4 + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encRight_cons_eq_one_cons_encTail, + encTail_succ 0, encTail_zero 0 ((1, c) :: tailAsRight R), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + exact stepPlus_trans + (h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L'''))) + (hpeel2 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) ((1 : Fin 2) >> rD)) + · -- a₂ = a₂'' + 2 + have hL : encTail ((1, b₁) :: (a₂'' + 2, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂'', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h1011 ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) + · -- b₁ % 4 = 1 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h100 (encTail ((a₂ + 1, b₂) :: L'')) + · -- b₁ % 4 = 2 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2, encTail_zero]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h100 (encTail ((0, 0) :: (a₂, b₂) :: L'')) + · -- b₁ % 4 = 3 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb3, encTail_zero]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using h100 (encTail ((0, 1) :: (a₂, b₂) :: L'')) + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ + +-- ============================================================================ +-- Stage 3: Pushdown Induction & Universal Wipe Helpers +-- ============================================================================ + +lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : + (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by + induction n with + | zero => rfl + | succ n' ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] + +lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : + (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = + (([0] : List (Fin 2)) ^ k) +> wall L := by + induction k with + | zero => rfl + | succ k' ih => + have hsucc : k' + 1 + 5 = (k' + 5) + 1 := by omega + rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, + pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] + +lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ + | 0, l, tR => by execute 3 + | k + 1, l, tR => by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 1 + have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR + rw [zero_pow_append_zero (k + 1) l] at h2 + exact stepPlus_trans h1 h2 + +lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 2 + have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR + rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 + exact stepPlus_trans h1 h2 + +lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, + ← encTail_peelSep b ((a, b') :: S')] + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 2 | .F07 => 0 | .F08 => 1 | .F09 => 1 | .F10 => 0 | .F11 => 1 | .F12 => 2 | .F13 => 2 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 0 | .F10 => 1 | .F11 => 2 | .F12 => 1 | .F13 => 1 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ := by + have henc : encRight ((k + 1, b) :: R_tail) = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, + zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] + unfold P_cfg + rw [henc] + have hwipe := A_wipe_ones k (W +> wall L'') (encTail (peelSep b R_tail)) + rw [listblank_append_right_assoc, listblank_append_cons] + exact hwipe + +lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + execute 4 + +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 4 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 3 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 +lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 +lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 3 +lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 7 +lemma F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F09 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 +lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ + +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (_ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F02_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F06 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F07, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F07 => exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + | F09 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F10 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F02, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F11 => exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ + | F12 => + have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 1) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 1) :: R₁) = 0 + w ((0, 1) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 1) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F13 => + have hne_0 : ((0, 3) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 3) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 3 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (0, 3) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F02 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ + | F06 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F08 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F09 => exact Or.inl ⟨F_cfg .F09 L'' (1 :: W_out) R₁, h_reach, F09_bit1_halt L'' W_out R₁⟩ + | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + | F11 => exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F11_bit1 L'' W_out R₁)⟩ + | F12 => + have hne_0 : ((0, 3) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 3) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 3 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 3) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F12_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F13 => exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ + +lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} + {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, + (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → + R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → + (∀ R', R' ≠ [] → w R' < W_max → Qz R') → + (∀ R', R' ≠ [] → w R' < W_max → Qz1 R') → + Stage3Out start L'' W_rest (B + m) C1 + | 0, start, L'', W_rest, B, _, s, R₁, h_reach, hR₁, hw₁, _, _, _ => by + rw [pow_zero_list, nil_append_list] at h_reach + exact Or.inr ⟨s, R₁, hR₁, by omega, h_reach⟩ + | m + 1, start, L'', W_rest, B, W_max, s, R₁, h_reach, hR₁, hw₁, hmax, ih_z, ih_z1 => by + rw [pow_succ_list, cons_append_list, nil_append_list, cons_append_list] at h_reach + have hc0 := C0_le_C1_succ s + have hw0 : w R₁ + C0 s ≤ B + 1 := by omega + rcases step_bit0 h_reach hR₁ hw0 + (fun R' hR' hlt => ih_z R' hR' (by omega)) + (fun R' hR' hlt => ih_z1 R' hR' (by omega)) with + ⟨cfg', h1, h2⟩ | ⟨s', R₂, hR₂, hw₂, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · have hrec := step_zeros_c1 m h1 hR₂ hw₂ (by omega : (B + 1) + m ≤ W_max) ih_z ih_z1 + rcases hrec with ⟨cfg', g1, g2⟩ | ⟨sf, Rf, hRf, hwf, g1⟩ + · exact Or.inl ⟨cfg', g1, g2⟩ + · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | k + · -- a = 0 + rcases R_tail with _ | ⟨r₂, rs⟩ + · refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = k + 1 + have hpre := P_step_ge1_pre L'' W_base k b R_tail + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p : (P_cfg L'' W_base ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg L'' (0 :: ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base))) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg at hpre ⊢ + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + have hw_tail : w R_tail + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] + have : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · rw [hw_tail] at hw2 + exact step_bit1 h2 hR2 hw2 ih_z + · have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by + have hl := encRight_zero_peelInner b R_tail hcond + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ + P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by + unfold P_cfg + rw [hz] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, + encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] + rfl + rw [hr1] + exact A_peel_two_zeros (((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) +> wall L'') + (encTail ((ai, bi) :: rsi)) + have hw1 : w R1 + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, ← w_peelInner_zero b R_tail hcond] + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + have h_p := stepPlus_trans hpre hpost + rcases hQ0_R1 L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R_out1, hne1, hw_out1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by + have := C1_le_C0_succ s1 + omega + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega + exact step_bit1 h2 hne2 hw2 ih_z + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 + +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 1 + +lemma F06_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 4 + +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 + +lemma F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 2 + +lemma F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 1 + +lemma F10_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 + +lemma F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 + +lemma F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 + +lemma F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 1 + +lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by + cases s with + | F00 => exact ⟨_, _, F00_exit L'' R⟩ + | F01 => exact ⟨_, _, F01_exit L'' R⟩ + | F02 => exact ⟨_, _, F02_exit L'' R⟩ + | F03 => exact ⟨_, _, F03_exit L'' R⟩ + | F04 => exact ⟨_, _, F04_exit L'' R⟩ + | F05 => exact ⟨_, _, F05_exit L'' R⟩ + | F06 => exact ⟨_, _, F06_exit L'' R⟩ + | F07 => exact ⟨_, _, F07_exit L'' R⟩ + | F08 => exact ⟨_, _, F08_exit L'' R⟩ + | F09 => exact ⟨_, _, F09_exit L'' R⟩ + | F10 => exact ⟨_, _, F10_exit L'' R⟩ + | F11 => exact ⟨_, _, F11_exit L'' R⟩ + | F12 => exact ⟨_, _, F12_exit L'' R⟩ + | F13 => exact ⟨_, _, F13_exit L'' R⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, _, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · obtain ⟨L_out, R_out', h2⟩ := F_exit_all s L'' R_out + exact ⟨cfg_M0 L_out R_out', stepPlus_trans h1 h2, Or.inl ⟨.M0, L_out, R_out', rfl⟩⟩ + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) + (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + cases s with + | F00 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F00_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F01_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F02_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F03_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F04_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F05_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F06_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F07 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F07_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F08 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F08_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F09 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F09_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F10 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F10_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F11 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F11_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F12 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F12_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F13 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F13_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + +lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), + R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) + | 0, start, L'', R, hR, h_reach => by + rw [pow_zero_list] at h_reach + obtain ⟨cfg', h2, hout⟩ := stage3_closed L'' R hR + exact ⟨cfg', stepPlus_trans h_reach h2, hout⟩ + | k + 1, start, L'', R, hR, h_reach => by + rw [pow_succ_list, cons_append_list, nil_append_list] at h_reach + rcases (stage3_ind (w R) R hR rfl).2.1 L'' (([0] : List (Fin 2)) ^ k) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact ⟨cfg', stepPlus_trans h_reach h1, Or.inr h2⟩ + · have hp1 := stepPlus_trans h_reach h1 + rw [← append_nil_list (([0] : List (Fin 2)) ^ k)] at hp1 + rcases step_zeros_c1 k hp1 hR1 hw1 (Nat.le_refl _) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.1) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.2) with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, _, h2⟩ + · exact ⟨cfg', h2, Or.inr h3⟩ + · exact F_empty_closed s2 L'' R2 hR2 h2 + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 5 + +lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ + ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by + have htail : encTail ((k + 5, bR) :: R') = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] + rw [cfg_M0_eq, htail] + have hw := A_wipe_ones (k + 3) (encTail L) (encTail (peelSep bR R')) + rw [zero_pow_wall k L] at hw + exact hw + +lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hpre := M0_add5_pre L k bR R' + by_cases h_rec : R' ≠ [] ∧ bR % 4 = 0 + · obtain ⟨hne, hb0⟩ := h_rec + rcases R' with _ | ⟨⟨a₂, b₂⟩, R''⟩ + · contradiction + · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by + unfold P_cfg + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost + · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by + rcases R' with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have hz : encTail (peelSep bR R') = (0 : Fin 2) >> encTail (peelInner bR R') := by + have hl := encRight_zero_peelInner bR R' hcond + rw [encRight_cons_eq_one_cons_encTail 0 bR R', encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + rcases h_in : peelInner bR R' with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil bR R' h_in) + · rcases k with _ | _ | k' + · -- k = 0 (d = 5) -> cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = 1 (d = 6) -> cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = k' + 2 (d >= 7) -> P_cfg L ([0] ^ k') ((0, 0) :: peelInner bR R') + rw [hz, h_in] at hpre + have hp2 : (cfg_M0 L ((k' + 7, bR) :: R')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k') ((0, 0) :: (ai, bi) :: rsi) := by + unfold P_cfg + rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons] at hpre ⊢ + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 + +theorem stage1_step_all (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr (Or.inr ⟨L, [], rfl⟩)⟩ + · rcases d with _ | _ | _ | _ | _ | k + · exact ⟨_, M0_zero L bR R', Or.inr (Or.inr ⟨L, peelSep bR R', rfl⟩)⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_three L bR R', Or.inl ⟨.M0, (0, 2) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_four L bR R', Or.inl ⟨.M0, (0, 3) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · obtain ⟨cfg', h, hout⟩ := M0_add5_closed L k bR R' + rcases hout with hM | hH + · exact ⟨cfg', h, Or.inl hM⟩ + · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step_all L R + rcases hout₁ with hM₁ | hH₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · exact ⟨cfg₁, h₁, Or.inr hH₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH + diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean new file mode 100644 index 00000000..baedc86d --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean @@ -0,0 +1,1430 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 0 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by + have := Nat.mod_lt b (by decide : 0 < 4) + omega + +def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 5 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 (for #49: F0 = 0LC -> ultra-short 3-step leaves!) + have h100 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 3 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · have hL : encTail [(1, b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using h100 default + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_D 1 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + execute 3 + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using h100 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using h100 ((0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using h100 ((0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ + +-- ============================================================================ +-- Stage 3: Pushdown Induction & Universal Wipe Helpers +-- ============================================================================ + +lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : + (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by + induction n with + | zero => rfl + | succ n' ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] + +lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : + (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = + (([0] : List (Fin 2)) ^ k) +> wall L := by + induction k with + | zero => rfl + | succ k' ih => + have hsucc : k' + 1 + 5 = (k' + 5) + 1 := by omega + rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, + pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] + +lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ + | 0, l, tR => by execute 3 + | k + 1, l, tR => by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 1 + have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR + rw [zero_pow_append_zero (k + 1) l] at h2 + exact stepPlus_trans h1 h2 + +lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 2 + have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR + rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 + exact stepPlus_trans h1 h2 + +lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, + ← encTail_peelSep b ((a, b') :: S')] + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 2 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 2 | .F08 => 1 | .F09 => 1 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ := by + have henc : encRight ((k + 1, b) :: R_tail) = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, + zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] + unfold P_cfg + rw [henc] + have hwipe := A_wipe_ones k (W +> wall L'') (encTail (peelSep b R_tail)) + rw [listblank_append_right_assoc, listblank_append_cons] + exact hwipe + +lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + execute 4 + +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 4 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 1 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 +lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 3 +lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 +lemma F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F09 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ + +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (_ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F02_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F06 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F06_bit0 L'' W_out R₁) + rcases _ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + | F08 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F09 => + have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (0, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F02 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ + | F06 => exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F08 => + have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F09 => exact Or.inl ⟨F_cfg .F09 L'' (1 :: W_out) R₁, h_reach, F09_bit1_halt L'' W_out R₁⟩ + +lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} + {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, + (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → + R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → + (∀ R', R' ≠ [] → w R' < W_max → Qz R') → + (∀ R', R' ≠ [] → w R' < W_max → Qz1 R') → + Stage3Out start L'' W_rest (B + m) C1 + | 0, start, L'', W_rest, B, _, s, R₁, h_reach, hR₁, hw₁, _, _, _ => by + rw [pow_zero_list, nil_append_list] at h_reach + exact Or.inr ⟨s, R₁, hR₁, by omega, h_reach⟩ + | m + 1, start, L'', W_rest, B, W_max, s, R₁, h_reach, hR₁, hw₁, hmax, ih_z, ih_z1 => by + rw [pow_succ_list, cons_append_list, nil_append_list, cons_append_list] at h_reach + have hc0 := C0_le_C1_succ s + have hw0 : w R₁ + C0 s ≤ B + 1 := by omega + rcases step_bit0 h_reach hR₁ hw0 + (fun R' hR' hlt => ih_z R' hR' (by omega)) + (fun R' hR' hlt => ih_z1 R' hR' (by omega)) with + ⟨cfg', h1, h2⟩ | ⟨s', R₂, hR₂, hw₂, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · have hrec := step_zeros_c1 m h1 hR₂ hw₂ (by omega : (B + 1) + m ≤ W_max) ih_z ih_z1 + rcases hrec with ⟨cfg', g1, g2⟩ | ⟨sf, Rf, hRf, hwf, g1⟩ + · exact Or.inl ⟨cfg', g1, g2⟩ + · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | k + · -- a = 0 + rcases R_tail with _ | ⟨r₂, rs⟩ + · refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = k + 1 + have hpre := P_step_ge1_pre L'' W_base k b R_tail + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p : (P_cfg L'' W_base ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg L'' (0 :: ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base))) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg at hpre ⊢ + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + have hw_tail : w R_tail + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] + have : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · rw [hw_tail] at hw2 + exact step_bit1 h2 hR2 hw2 ih_z + · have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by + have hl := encRight_zero_peelInner b R_tail hcond + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ + P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by + unfold P_cfg + rw [hz] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, + encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] + rfl + rw [hr1] + exact A_peel_two_zeros (((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) +> wall L'') + (encTail ((ai, bi) :: rsi)) + have hw1 : w R1 + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, ← w_peelInner_zero b R_tail hcond] + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + have h_p := stepPlus_trans hpre hpost + rcases hQ0_R1 L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R_out1, hne1, hw_out1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by + have := C1_le_C0_succ s1 + omega + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega + exact step_bit1 h2 hne2 hw2 ih_z + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 + +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 2 + +lemma F06_p_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ P_cfg L'' [] R := by + dsimp only [F_cfg, P_cfg, wall]; rw [listblank_append_nil]; execute 1 + +lemma F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 + +lemma F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 + +lemma F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((1, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 2 + +lemma stage3_closed_aux (W_val : ℕ) : + ∀ L'' R, R ≠ [] → w R = W_val → + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_exit => + intro L'' R hR hw + have hQ0 : Q0 R := (stage3_ind W_val R hR hw).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, hR_out, hw_out, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · rw [hw] at hw_out + cases s with + | F00 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F00_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F01_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F02_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F03_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F04_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F05_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => + have hlt_out : w R_out < W_val := by dsimp [C0] at hw_out; omega + have hp := stepPlus_trans h1 (F06_p_exit L'' R_out) + obtain ⟨cfg'', h2, hout2⟩ := ih_exit (w R_out) hlt_out L'' R_out hR_out rfl + exact ⟨cfg'', stepPlus_trans hp h2, hout2⟩ + | F07 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F07_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F08 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F08_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F09 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F09_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := + stage3_closed_aux (w R) L'' R hR rfl + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) + (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + cases s with + | F00 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F00_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F01_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F02_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F03_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F04_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F05_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => + obtain ⟨cfg'', h3, hout3⟩ := stage3_closed L'' R _hR + exact ⟨cfg'', stepPlus_trans (stepPlus_trans h_reach (F06_p_exit L'' R)) h3, hout3⟩ + | F07 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F07_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F08 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F08_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F09 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F09_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + +lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), + R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) + | 0, start, L'', R, hR, h_reach => by + rw [pow_zero_list] at h_reach + obtain ⟨cfg', h2, hout⟩ := stage3_closed L'' R hR + exact ⟨cfg', stepPlus_trans h_reach h2, hout⟩ + | k + 1, start, L'', R, hR, h_reach => by + rw [pow_succ_list, cons_append_list, nil_append_list] at h_reach + rcases (stage3_ind (w R) R hR rfl).2.1 L'' (([0] : List (Fin 2)) ^ k) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact ⟨cfg', stepPlus_trans h_reach h1, Or.inr h2⟩ + · have hp1 := stepPlus_trans h_reach h1 + rw [← append_nil_list (([0] : List (Fin 2)) ^ k)] at hp1 + rcases step_zeros_c1 k hp1 hR1 hw1 (Nat.le_refl _) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.1) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.2) with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, _, h2⟩ + · exact ⟨cfg', h2, Or.inr h3⟩ + · exact F_empty_closed s2 L'' R2 hR2 h2 + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 5 + +lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ + ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by + have htail : encTail ((k + 5, bR) :: R') = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] + rw [cfg_M0_eq, htail] + have hw := A_wipe_ones (k + 3) (encTail L) (encTail (peelSep bR R')) + rw [zero_pow_wall k L] at hw + exact hw + +lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hpre := M0_add5_pre L k bR R' + by_cases h_rec : R' ≠ [] ∧ bR % 4 = 0 + · obtain ⟨hne, hb0⟩ := h_rec + rcases R' with _ | ⟨⟨a₂, b₂⟩, R''⟩ + · contradiction + · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by + unfold P_cfg + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost + · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by + rcases R' with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have hz : encTail (peelSep bR R') = (0 : Fin 2) >> encTail (peelInner bR R') := by + have hl := encRight_zero_peelInner bR R' hcond + rw [encRight_cons_eq_one_cons_encTail 0 bR R', encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + rcases h_in : peelInner bR R' with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil bR R' h_in) + · rcases k with _ | _ | k' + · -- k = 0 (d = 5) -> cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = 1 (d = 6) -> cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = k' + 2 (d >= 7) -> P_cfg L ([0] ^ k') ((0, 0) :: peelInner bR R') + rw [hz, h_in] at hpre + have hp2 : (cfg_M0 L ((k' + 7, bR) :: R')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k') ((0, 0) :: (ai, bi) :: rsi) := by + unfold P_cfg + rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons] at hpre ⊢ + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 + +theorem stage1_step_all (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr (Or.inr ⟨L, [], rfl⟩)⟩ + · rcases d with _ | _ | _ | _ | _ | k + · exact ⟨_, M0_zero L bR R', Or.inr (Or.inr ⟨L, peelSep bR R', rfl⟩)⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_three L bR R', Or.inl ⟨.M0, (0, 2) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_four L bR R', Or.inl ⟨.M0, (0, 3) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · obtain ⟨cfg', h, hout⟩ := M0_add5_closed L k bR R' + rcases hout with hM | hH + · exact ⟨cfg', h, Or.inl hM⟩ + · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step_all L R + rcases hout₁ with hM₁ | hH₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · exact ⟨cfg₁, h₁, Or.inr hH₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH + diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean new file mode 100644 index 00000000..5af139ce --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean @@ -0,0 +1,1448 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by + have := Nat.mod_lt b (by decide : 0 < 4) + omega + +def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{A}} encRight R + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 5 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one_right : (1 : Fin 2) >> (1 : Fin 2) >> rD = encRight ((1, c) :: tailAsRight R) := by + rw [hrD_tail, ← encRight_cons_eq_one_cons_encTail] + have hrD_two : (1 : Fin 2) >> (1 : Fin 2) >> rD = encTail ((2, c) :: tailAsRight R) := by + rw [hrD_tail, ← encTail_succ] + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 (for #301: F0 = 1LA) + have h100 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 2 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · have hL : encTail [(1, b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_two] + exact h100 default + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0 + rcases a₂ with _ | a₂' + · -- a₂ = 0 + by_cases h_rec2 : L'' ≠ [] ∧ b₂ % 4 = 0 + · obtain ⟨hne2, hb20⟩ := h_rec2 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · contradiction + · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, hb20, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((1, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (1, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_tail] + execute 5 + · have hcond2 : L'' = [] ∨ b₂ % 4 ≠ 0 := by + rcases L'' with _ | ⟨_, _⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec2 ⟨by simp, h0⟩) + have hz2 : encTail ((0, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b₂ L'') := by + have hl := encRight_zero_peelInner b₂ L'' hcond2 + rw [encRight_cons_eq_one_cons_encTail 0 b₂ L''] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg ListBlank.tail hl + have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b₂ L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, hz2] + rfl + rw [hL] + refine ⟨cfg_M0 (peelSep b₂ L'') ((0, 0) :: (1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + have hsep : encTail (peelSep b₂ L'') = (0 : Fin 2) >> encTail (peelInner b₂ L'') := by + have hz0 : encTail ((0, b₂) :: L'') = (0 : Fin 2) >> encTail (peelSep b₂ L'') := by + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b₂ % 4), listblank_append_cons, + ← encTail_peelSep b₂ ((a₃, b₃) :: L''')] + rw [hz0] at hz2 + simpa only [Turing.ListBlank.tail_cons] using congrArg ListBlank.tail hz2 + rw [cfg_M0_eq, hsep, encTail_zero 0 ((1, c) :: tailAsRight R)] + simpa [hrD_one_right] using (by execute 5 : + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b₂ L'')) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> encTail (peelInner b₂ L''), + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩) + · -- a₂ = a₂' + 1 + have h1011 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 6 + rcases a₂' with _ | a₂'' + · -- a₂ = 1: split b₂ % 4 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_two] + simpa using h1011 ((0 : Fin 2) >> encRight L'') + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_two] + simpa using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') + · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22]; rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_two] + simpa using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') + · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(1, b₁), (1, b₂)] = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_two] + simpa using h1011 default + · have hL : encTail ((1, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((1, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (1, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_one_right] + exact h1011 _ + · -- a₂ = a₂'' + 2 + have hL : encTail ((1, b₁) :: (a₂'' + 2, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂'', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + simpa using h1011 ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) + · -- b₁ % 4 = 1 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_two] + exact h100 (encTail ((a₂ + 1, b₂) :: L'')) + · -- b₁ % 4 = 2 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2, encTail_zero]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_two] + exact h100 (encTail ((0, 0) :: (a₂, b₂) :: L'')) + · -- b₁ % 4 = 3 + have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb3, encTail_zero]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_two] + exact h100 (encTail ((0, 1) :: (a₂, b₂) :: L'')) + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ +-- Stage 3: Pushdown Induction & Universal Wipe Helpers +-- ============================================================================ + +lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : + (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by + induction n with + | zero => rfl + | succ n' ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] + +lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : + (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = + (([0] : List (Fin 2)) ^ k) +> wall L := by + induction k with + | zero => rfl + | succ k' ih => + have hsucc : k' + 1 + 5 = (k' + 5) + 1 := by omega + rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, + pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] + +lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ + | 0, l, tR => by execute 3 + | k + 1, l, tR => by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 1 + have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR + rw [zero_pow_append_zero (k + 1) l] at h2 + exact stepPlus_trans h1 h2 + +lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 2 + have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR + rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 + exact stepPlus_trans h1 h2 + +lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, + ← encTail_peelSep b ((a, b') :: S')] + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 0 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ := by + have henc : encRight ((k + 1, b) :: R_tail) = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, + zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] + unfold P_cfg + rw [henc] + have hwipe := A_wipe_ones k (W +> wall L'') (encTail (peelSep b R_tail)) + rw [listblank_append_right_assoc, listblank_append_cons] + exact hwipe + +lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + execute 4 + +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by + dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 4 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((1, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 1 2]; execute 1 +lemma F06_eq_P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + F_cfg .F06 L'' (0 :: W) R = P_cfg L'' W R := by + simp [F_cfg, P_cfg] + +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 3 +lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W R := by + dsimp only [F_cfg]; execute 1 +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W R := by + dsimp only [F_cfg]; execute 1 + +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (ih_0 : ∀ R', R' ≠ [] → w R' < W_bound → Q0 R') + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F02_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => + have hne_0 : ((1, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((1, 2) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 1 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F06, (1, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F06 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + rw [F06_eq_P_cfg] at h_reach + rcases ih_0 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_reach h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_reach h1⟩ + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F02 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ + | F06 => exact Or.inr ⟨.F00, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + +lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} + {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, + (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → + R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → + (∀ R', R' ≠ [] → w R' < W_max → Q0 R') → + (∀ R', R' ≠ [] → w R' < W_max → Qz1 R') → + Stage3Out start L'' W_rest (B + m) C1 + | 0, start, L'', W_rest, B, _, s, R₁, h_reach, hR₁, hw₁, _, _, _ => by + rw [pow_zero_list, nil_append_list] at h_reach + exact Or.inr ⟨s, R₁, hR₁, by omega, h_reach⟩ + | m + 1, start, L'', W_rest, B, W_max, s, R₁, h_reach, hR₁, hw₁, hmax, ih_0, ih_z1 => by + rw [pow_succ_list, cons_append_list, nil_append_list, cons_append_list] at h_reach + have hc0 := C0_le_C1_succ s + have hw0 : w R₁ + C0 s ≤ B + 1 := by omega + rcases step_bit0 h_reach hR₁ hw0 + (fun R' hR' hlt => ih_0 R' hR' (by omega)) + (fun R' hR' hlt => ih_z1 R' hR' (by omega)) with + ⟨cfg', h1, h2⟩ | ⟨s', R₂, hR₂, hw₂, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · have hrec := step_zeros_c1 m h1 hR₂ hw₂ (by omega : (B + 1) + m ≤ W_max) ih_0 ih_z1 + rcases hrec with ⟨cfg', g1, g2⟩ | ⟨sf, Rf, hRf, hwf, g1⟩ + · exact Or.inl ⟨cfg', g1, g2⟩ + · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_0 : ∀ R', R' ≠ [] → w R' < W_val → Q0 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).1 + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | k + · -- a = 0 + rcases R_tail with _ | ⟨r₂, rs⟩ + · refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = k + 1 + have hpre := P_step_ge1_pre L'' W_base k b R_tail + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p : (P_cfg L'' W_base ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg L'' (0 :: ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base))) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg at hpre ⊢ + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + have hw_tail : w R_tail + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] + have : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · rw [hw_tail] at hw2 + exact step_bit1 h2 hR2 hw2 ih_z + · have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by + have hl := encRight_zero_peelInner b R_tail hcond + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ + P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by + unfold P_cfg + rw [hz] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, + encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] + rfl + rw [hr1] + exact A_peel_two_zeros (((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) +> wall L'') + (encTail ((ai, bi) :: rsi)) + have hw1 : w R1 + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, ← w_peelInner_zero b R_tail hcond] + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + have h_p := stepPlus_trans hpre hpost + rcases hQ0_R1 L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R_out1, hne1, hw_out1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by + have := C1_le_C0_succ s1 + omega + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_0 ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega + exact step_bit1 h2 hne2 hw2 ih_z + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_0 ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 + +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 1 + +lemma F06_exit_eq (L'' R : List (ℕ × ℕ)) : + F_cfg .F06 L'' [] R = cfg_M0 ((0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall] + rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_rightAsTail] + simp + +lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) + (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + cases s with + | F00 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F00_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F01_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F02_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F03_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F04_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F05_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => + rw [F06_exit_eq] at h_reach + exact ⟨cfg_M0 _ _, h_reach, Or.inl ⟨.M0, _, _, rfl⟩⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, hR_out, _, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · exact F_empty_closed s L'' R_out hR_out h1 + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), + R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) + | 0, start, L'', R, hR, h_reach => by + rw [pow_zero_list] at h_reach + obtain ⟨cfg', h2, hout⟩ := stage3_closed L'' R hR + exact ⟨cfg', stepPlus_trans h_reach h2, hout⟩ + | k + 1, start, L'', R, hR, h_reach => by + rw [pow_succ_list, cons_append_list, nil_append_list] at h_reach + rcases (stage3_ind (w R) R hR rfl).2.1 L'' (([0] : List (Fin 2)) ^ k) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact ⟨cfg', stepPlus_trans h_reach h1, Or.inr h2⟩ + · have hp1 := stepPlus_trans h_reach h1 + rw [← append_nil_list (([0] : List (Fin 2)) ^ k)] at hp1 + rcases step_zeros_c1 k hp1 hR1 hw1 (Nat.le_refl _) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).1) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.2) with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, _, h2⟩ + · exact ⟨cfg', h2, Or.inr h3⟩ + · exact F_empty_closed s2 L'' R2 hR2 h2 + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 5 + +lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ + ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by + have htail : encTail ((k + 5, bR) :: R') = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] + rw [cfg_M0_eq, htail] + have hw := A_wipe_ones (k + 3) (encTail L) (encTail (peelSep bR R')) + rw [zero_pow_wall k L] at hw + exact hw + +lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + have hpre := M0_add5_pre L k bR R' + by_cases h_rec : R' ≠ [] ∧ bR % 4 = 0 + · obtain ⟨hne, hb0⟩ := h_rec + rcases R' with _ | ⟨⟨a₂, b₂⟩, R''⟩ + · contradiction + · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by + unfold P_cfg + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost + · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by + rcases R' with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have hz : encTail (peelSep bR R') = (0 : Fin 2) >> encTail (peelInner bR R') := by + have hl := encRight_zero_peelInner bR R' hcond + rw [encRight_cons_eq_one_cons_encTail 0 bR R', encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + rcases h_in : peelInner bR R' with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil bR R' h_in) + · rcases k with _ | _ | k' + · -- k = 0 (d = 5) -> cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = 1 (d = 6) -> cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: peelInner bR R') + refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · -- k = k' + 2 (d >= 7) -> P_cfg L ([0] ^ k') ((0, 0) :: peelInner bR R') + rw [hz, h_in] at hpre + have hp2 : (cfg_M0 L ((k' + 7, bR) :: R')) [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k') ((0, 0) :: (ai, bi) :: rsi) := by + unfold P_cfg + rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons] at hpre ⊢ + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 + +theorem stage1_step_all (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr (Or.inr ⟨L, [], rfl⟩)⟩ + · rcases d with _ | _ | _ | _ | _ | k + · exact ⟨_, M0_zero L bR R', Or.inr (Or.inr ⟨L, peelSep bR R', rfl⟩)⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_three L bR R', Or.inl ⟨.M0, (0, 2) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_four L bR R', Or.inl ⟨.M0, (0, 3) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · obtain ⟨cfg', h, hout⟩ := M0_add5_closed L k bR R' + rcases hout with hM | hH + · exact ⟨cfg', h, Or.inl hM⟩ + · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step_all L R + rcases hout₁ with hM₁ | hH₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · exact ⟨cfg₁, h₁, Or.inr hH₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean new file mode 100644 index 00000000..65b0ad03 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean @@ -0,0 +1,1548 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 1 Dir.left) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +def A : Fin 6 := 0 +def B : Fin 6 := 1 +def C : Fin 6 := 2 +def D : Fin 6 := 3 +def E : Fin 6 := 4 +def F : Fin 6 := 5 + +open BusyBeaver.PairStack Counter + +lemma zero_pow_one_add (n : ℕ) : + (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by + rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + +def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] lemma encLeft_nil : encLeft [] = default := rfl +@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] lemma encRight_nil : encRight [] = default := rfl +@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl + +lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + induction S with + | nil => rfl + | cons p S' ih => + rcases p with ⟨a, b⟩ + simp only [encLeft, encRight, ih] + +@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] lemma encTail_nil : encTail [] = default := rfl + +lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by + simp only [encRight_cons, Nat.one_mul] + rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] + rfl + +lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : + encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by + rw [encTail_cons]; rfl + +lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by + unfold encTail + rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] + +lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by + have := Nat.mod_lt b (by decide : 0 < 4) + omega + +def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => + if k % 4 = 0 then (a + 1, b') :: S + else (0, k % 4 - 1) :: (a, b') :: S + +def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a₂, b₂) :: rs => + if b % 4 = 1 then (a₂ + 1, b₂) :: rs + else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs + else (0, 1) :: (a₂, b₂) :: rs + +lemma encRight_bumpHead (S : List (ℕ × ℕ)) : + encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [bumpHead] + · exact encRight_succ a b S' + +lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : + encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · simp [tailAsRight] + · exact encRight_cons_eq_one_cons_encTail a b S' + +lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : + encTail (rightAsTail S) = encRight S := by + rcases S with _ | ⟨⟨a, b⟩, S'⟩ + · rfl + · unfold encTail rightAsTail + rw [encRight_succ, Turing.ListBlank.tail_cons] + +lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : + encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [pushZeroSep] + · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] + +lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : + encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep] + · rcases mod4_cases k with h0 | h1 | h2 | h3 + · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + · simp [peelSep, h1, encTail_zero] + · simp [peelSep, h2, encTail_zero] + · simp [peelSep, h3, encTail_zero] + +lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner] + · dsimp [peelInner] + split_ifs <;> simp + +lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · simp [peelInner, encTail_zero] + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + encRight_cons_eq_one_cons_encTail] + rfl + · have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rfl + · have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by + rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] + +-- ============================================================================ +-- Stack System Definition & Witness Checks +-- ============================================================================ + +def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +inductive StackMode + | M0 +deriving DecidableEq + +def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : + cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by + simp [cfg_M0, encRight_tail] + +lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by + intro m + cases m with + | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ + +theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeft ((a, b) :: L)).head = 1 := by + rw [encLeft_eq_encRight] + exact audit_encRight_head a b L + +theorem audit_encRight_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + intro R h + rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ + · have h1 := congrArg (fun s => s.head) h + simp at h1 + · rcases R' with _ | ⟨⟨d', b'⟩, R''⟩ + · rw [encRight_cons_simp] at h + have h1 := congrArg (fun s => s.tail.tail.tail.tail.tail.tail.head) h + simp at h1 + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rw [encRight_cons_simp, h0] at h + have hc := congrArg (fun s => s.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h1] at h + have hc := congrArg (fun s => s.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h2] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_cons_simp, h3] at h + have hc := congrArg (fun s => s.tail.tail.tail.tail.tail.head) h + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, Turing.ListBlank.tail_cons, + Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + · rw [encRight_succ] at h + have hc := congrArg (fun s => s.tail.head) h + simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc + contradiction + +theorem audit_encLeft_not_surjective : + ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by + obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective + exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ + +-- ============================================================================ +-- Execution Tactics & Initial Reachability +-- ============================================================================ + +macro "finish" : tactic => `(tactic| ( + refine ⟨0, ?_⟩ + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + zero_cons_default, listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, multiStep_zero] + rfl)) + +macro "step" : tactic => `(tactic| ( + try refine stepPlus_stepStar ?_ + try simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + apply step_stepStar_stepPlus (by rfl) + simp only [Turing.Tape.move, pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_cons, listblank_append_nil, + Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail])) + +macro "execute" n:num : tactic => `(tactic| ( + iterate $n step + finish)) + +lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : + (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by + unfold step + simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] + +theorem init_reaches_stack_system : + ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by + refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ + rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] + simp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] + execute 4 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) + +def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' + +def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ + +inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 +deriving DecidableEq + +def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) + | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> encRight R) + | .F08, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + +-- Stage 3: Pushdown Induction & Universal Wipe Helpers +-- ============================================================================ + +lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : + (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by + induction n with + | zero => rfl + | succ n' ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] + +lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : + (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = + (([0] : List (Fin 2)) ^ k) +> wall L := by + induction k with + | zero => rfl + | succ k' ih => + have hsucc : k' + 1 + 5 = (k' + 5) + 1 := by omega + rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, + pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] + +lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ + | 0, l, tR => by execute 3 + | k + 1, l, tR => by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 1 + have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR + rw [zero_pow_append_zero (k + 1) l] at h2 + exact stepPlus_trans h1 h2 + +lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + execute 2 + have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR + rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 + exact stepPlus_trans h1 h2 + +lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by + rcases S with _ | ⟨⟨a, b'⟩, S'⟩ + · simp [peelSep, encTail_zero] + · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, + ← encTail_peelSep b ((a, b') :: S')] + +def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 2 | .F07 => 1 | .F08 => 1 | .F09 => 2 | .F10 => 2 | .F11 => 3 + +def C1 : FState → ℕ + | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 1 | .F10 => 1 | .F11 => 2 + +lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w ((a, b) :: R) = a + b % 2 + w R := by + rcases R with _ | ⟨r₂, rs⟩ + · contradiction + · rfl + +lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : + w (bumpHead R) = 1 + w R := by + rcases R with _ | ⟨⟨a, b⟩, rs⟩ + · contradiction + · rcases rs with _ | ⟨r₂, rs'⟩ + · simp [bumpHead, w]; omega + · simp [bumpHead, w]; omega + +lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by + rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · rfl + · rcases mod4_cases b with h0 | h1 | h2 | h3 + · rcases h with hnil | hne + · contradiction + · exact False.elim (hne h0) + · have hb2 : b % 2 = 1 := by omega + have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp + rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [hbmp, hb2]; omega + · have hb2 : b % 2 = 0 := by omega + have h1 : b % 4 ≠ 1 := by omega + rw [peelInner, if_neg h1, if_pos h2] + simp [w, hb2] + · have hb2 : b % 2 = 1 := by omega + have h1 : b % 4 ≠ 1 := by omega + have h2 : b % 4 ≠ 2 := by omega + rw [peelInner, if_neg h1, if_neg h2] + simp [w, hb2] + +lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : + w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by + rcases S with _ | ⟨r₂, rs⟩ + · simp [w] + · simp [w]; omega + +lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) + (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) + (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + dsimp only [P_cfg, F_cfg] + rw [encRight_zero_peelInner b R_tail h] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + execute 9 + +lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : + (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ := by + have henc : encRight ((k + 1, b) :: R_tail) = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, + zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] + unfold P_cfg + rw [henc] + have hwipe := A_wipe_ones k (W +> wall L'') (encTail (peelSep b R_tail)) + rw [listblank_append_right_assoc, listblank_append_cons] + exact hwipe + +lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + execute 4 + +lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 +lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 4 +lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W ((1, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_succ 0 2, encRight_cons_simp 0 2]; execute 1 +lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 1 +lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: bumpHead R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 +lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W ((1, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_succ 0 1, encRight_cons_simp 0 1]; execute 1 +lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by + dsimp only [F_cfg, P_cfg]; execute 3 +lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 +lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 +lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) ((0, 0) :: (0, 0) :: R) := by + dsimp only [F_cfg, P_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 +lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 1) :: R) := by + dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 +lemma F10_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (step target_tm (F_cfg .F10 L'' (1 :: W) R)).isNone = true := by + dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ +lemma F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) ((0, 0) :: bumpHead R) := by + dsimp only [F_cfg, P_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 + +def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) + (W_bound : ℕ) (C : FState → ℕ) : Prop := + (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ + (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ + (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) + +def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) + (_ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') + (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : + Stage3Out start L'' W_out W_bound C1 := by + cases s with + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F01 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F02 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F02_bit0 L'' W_out R₁) + rcases ih_z1 R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C1_le_C0_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F06 => + have hne_0 : ((1, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((1, 2) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 1 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F07, (1, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F07 => + have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega + have h_p := stepPlus_trans h_reach (F07_bit0 L'' W_out R₁) + rcases _ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F08 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + | F09 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + | F11 => + have hne_0 : ((1, 1) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((1, 1) :: R₁) = 2 + w (R₁) := by rw [w_cons_nonempty 1 1 (R₁) hR₁]; try omega + refine Or.inr ⟨.F07, (1, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + +lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} + {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} + (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) + (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) + (ih_z : ∀ R', R' ≠ [] → w R' < W_bound → Qz R') : + Stage3Out start L'' W_out W_bound C0 := by + cases s with + | F00 => + have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F00_bit1 L'' W_out R₁) + rcases ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F02 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F04 => + have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ + | F06 => + have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega + have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + have hlt : w ((0, 0) :: (0, 0) :: R₁) < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F06_bit1 L'' W_out R₁) + rcases ih_z ((0, 0) :: (0, 0) :: R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + | F09 => + have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp + have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega + refine Or.inr ⟨.F00, (0, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ + dsimp [C0, C1] at hw₁ ⊢; omega + | F10 => exact Or.inl ⟨F_cfg .F10 L'' (1 :: W_out) R₁, h_reach, F10_bit1_halt L'' W_out R₁⟩ + | F11 => + have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ + have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + have hlt : w ((0, 0) :: bumpHead R₁) < W_bound := by dsimp [C1] at hw₁; omega + have h_p := stepPlus_trans h_reach (F11_bit1 L'' W_out R₁) + rcases ih_z ((0, 0) :: bumpHead R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc := C0_le_C1_succ s' + exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ + +lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} + {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, + (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → + R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → + (∀ R', R' ≠ [] → w R' < W_max → Qz R') → + (∀ R', R' ≠ [] → w R' < W_max → Qz1 R') → + Stage3Out start L'' W_rest (B + m) C1 + | 0, start, L'', W_rest, B, _, s, R₁, h_reach, hR₁, hw₁, _, _, _ => by + rw [pow_zero_list, nil_append_list] at h_reach + exact Or.inr ⟨s, R₁, hR₁, by omega, h_reach⟩ + | m + 1, start, L'', W_rest, B, W_max, s, R₁, h_reach, hR₁, hw₁, hmax, ih_z, ih_z1 => by + rw [pow_succ_list, cons_append_list, nil_append_list, cons_append_list] at h_reach + have hc0 := C0_le_C1_succ s + have hw0 : w R₁ + C0 s ≤ B + 1 := by omega + rcases step_bit0 h_reach hR₁ hw0 + (fun R' hR' hlt => ih_z R' hR' (by omega)) + (fun R' hR' hlt => ih_z1 R' hR' (by omega)) with + ⟨cfg', h1, h2⟩ | ⟨s', R₂, hR₂, hw₂, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · have hrec := step_zeros_c1 m h1 hR₂ hw₂ (by omega : (B + 1) + m ≤ W_max) ih_z ih_z1 + rcases hrec with ⟨cfg', g1, g2⟩ | ⟨sf, Rf, hRf, hwf, g1⟩ + · exact Or.inl ⟨cfg', g1, g2⟩ + · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ + +theorem stage3_ind (W_val : ℕ) : + ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_w => + intro R hR hw + induction R with + | nil => contradiction + | cons hd R_tail ih_tail => + rcases hd with ⟨a, b⟩ + have hw_ab : w ((a, b) :: R_tail) = W_val := hw + have ih_z : ∀ R', R' ≠ [] → w R' < W_val → Qz R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.1 + have ih_z1 : ∀ R', R' ≠ [] → w R' < W_val → Qz1 R' := fun R' hR' hlt => + (ih_w (w R') hlt R' hR' rfl).2.2 + have hQ0 : Q0 ((a, b) :: R_tail) := by + intro L'' W_base + rw [hw_ab] + rcases a with _ | k + · -- a = 0 + rcases R_tail with _ | ⟨r₂, rs⟩ + · refine Or.inr ⟨.F00, (0, 0) :: peelInner b [], by simp, ?_, + P_step_0_other L'' W_base b [] (Or.inl rfl)⟩ + rw [w_peelInner_zero b [] (Or.inl rfl), C0]; omega + · rcases mod4_cases b with hb0 | hb1 | hb2 | hb3 + · have hne : (r₂ :: rs) ≠ [] := by simp + have hb2 : b % 2 = 0 := by omega + have hw_eq : w ((0, b) :: r₂ :: rs) = w (r₂ :: rs) := by simp [w, hb2] + have hQz1_tail : Qz1 (r₂ :: rs) := (ih_tail hne (by omega)).2.2 + have h_p := P_step_0_rec L'' W_base b hb0 (r₂ :: rs) hne + rcases hQz1_tail L'' W_base with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne_out, hw_out, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · exact Or.inr ⟨s', R_out, hne_out, by omega, stepPlus_trans h_p h1⟩ + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · have hcond : (r₂ :: rs) = [] ∨ b % 4 ≠ 0 := Or.inr (by omega) + refine Or.inr ⟨.F00, (0, 0) :: peelInner b (r₂ :: rs), by simp, ?_, + P_step_0_other L'' W_base b (r₂ :: rs) hcond⟩ + rw [w_peelInner_zero b (r₂ :: rs) hcond, C0]; omega + · -- a = k + 1 + have hpre := P_step_ge1_pre L'' W_base k b R_tail + by_cases h_rec : R_tail ≠ [] ∧ b % 4 = 0 + · obtain ⟨hne_tail, hb0⟩ := h_rec + have h_p : (P_cfg L'' W_base ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ + P_cfg L'' (0 :: ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base))) R_tail := by + rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ + · contradiction + · unfold P_cfg at hpre ⊢ + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + have hw_tail : w R_tail + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] + have : b % 2 = 0 := by omega + omega + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · rw [hw_tail] at hw2 + exact step_bit1 h2 hR2 hw2 ih_z + · have hcond : R_tail = [] ∨ b % 4 ≠ 0 := by + rcases R_tail with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + set R1 := (0, 0) :: peelInner b R_tail + have hR1 : R1 ≠ [] := by simp [R1] + have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by + have hl := encRight_zero_peelInner b R_tail hcond + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ + P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by + unfold P_cfg + rw [hz] + rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil b R_tail h_in) + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, + encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] + rfl + rw [hr1] + exact A_peel_two_zeros (((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) +> wall L'') + (encTail ((ai, bi) :: rsi)) + have hw1 : w R1 + (k + 1) = W_val := by + rw [← hw_ab, ← w_add_ge1 k b R_tail, ← w_peelInner_zero b R_tail hcond] + have hQ0_R1 : Q0 R1 := (ih_w (w R1) (by omega) R1 hR1 rfl).1 + have h_p := stepPlus_trans hpre hpost + rcases hQ0_R1 L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) with + ⟨cfg', h1, h2⟩ | ⟨s1, R_out1, hne1, hw_out1, h1⟩ + · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ + · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by + have := C1_le_C0_succ s1 + omega + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ + · exact Or.inl ⟨cfg', h2, h3⟩ + · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega + exact step_bit1 h2 hne2 hw2 ih_z + have hQz : Qz ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQ0 L'' (0 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s0, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit0 h1 hR1 hw1 ih_z ih_z1 + have hQz1 : Qz1 ((a, b) :: R_tail) := fun L'' W_base => by + rw [hw_ab] + rcases hQz L'' (1 :: W_base) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact Or.inl ⟨cfg', h1, h2⟩ + · rw [hw_ab] at hw1 + exact step_bit1 h1 hR1 hw1 ih_z + exact ⟨hQ0, hQz, hQz1⟩ + +lemma F00_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 + +lemma F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +lemma F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +lemma F03_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + +lemma F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +lemma F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 3 + +lemma F06_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((2, 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 2 + +lemma F07_p_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ P_cfg L'' [] R := by + dsimp only [F_cfg, P_cfg, wall]; rw [listblank_append_nil]; execute 1 + +lemma F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 + +lemma F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 + +lemma F10_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 3 + +lemma F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((2, 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 2 + +lemma stage3_closed_aux (W_val : ℕ) : + ∀ L'' R, R ≠ [] → w R = W_val → + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + induction W_val using Nat.strong_induction_on with + | h W_val ih_exit => + intro L'' R hR hw + have hQ0 : Q0 R := (stage3_ind W_val R hR hw).1 + rcases hQ0 L'' [] with ⟨cfg', h1, h2⟩ | ⟨s, R_out, hR_out, hw_out, h1⟩ + · exact ⟨cfg', h1, Or.inr h2⟩ + · rw [hw] at hw_out + cases s with + | F00 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F00_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F01_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F02_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F03_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F04_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F05_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F06_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F07 => + have hlt_out : w R_out < W_val := by dsimp [C0] at hw_out; omega + have hp := stepPlus_trans h1 (F07_p_exit L'' R_out) + obtain ⟨cfg'', h2, hout2⟩ := ih_exit (w R_out) hlt_out L'' R_out hR_out rfl + exact ⟨cfg'', stepPlus_trans hp h2, hout2⟩ + | F08 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F08_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F09 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F09_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F10 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F10_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F11 => + exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F11_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ + +theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : + ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := + stage3_closed_aux (w R) L'' R hR rfl + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) + (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + cases s with + | F00 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F00_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F01 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F01_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F02 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F02_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F03 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F03_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F04 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F04_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F05 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F05_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F06 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F06_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F07 => + obtain ⟨cfg'', h3, hout3⟩ := stage3_closed L'' R _hR + exact ⟨cfg'', stepPlus_trans (stepPlus_trans h_reach (F07_p_exit L'' R)) h3, hout3⟩ + | F08 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F08_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F09 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F09_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F10 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F10_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + | F11 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F11_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ + +lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), + R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) + | 0, start, L'', R, hR, h_reach => by + rw [pow_zero_list] at h_reach + obtain ⟨cfg', h2, hout⟩ := stage3_closed L'' R hR + exact ⟨cfg', stepPlus_trans h_reach h2, hout⟩ + | k + 1, start, L'', R, hR, h_reach => by + rw [pow_succ_list, cons_append_list, nil_append_list] at h_reach + rcases (stage3_ind (w R) R hR rfl).2.1 L'' (([0] : List (Fin 2)) ^ k) with + ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ + · exact ⟨cfg', stepPlus_trans h_reach h1, Or.inr h2⟩ + · have hp1 := stepPlus_trans h_reach h1 + rw [← append_nil_list (([0] : List (Fin 2)) ^ k)] at hp1 + rcases step_zeros_c1 k hp1 hR1 hw1 (Nat.le_refl _) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.1) + (fun R' hR' _ => (stage3_ind (w R') R' hR' rfl).2.2) with + ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, _, h2⟩ + · exact ⟨cfg', h2, Or.inr h3⟩ + · exact F_empty_closed s2 L'' R2 hR2 h2 + +lemma M0_nil (L : List (ℕ × ℕ)) : + (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by + rw [cfg_M0_eq, cfg_D, encTail_nil] + execute 3 + +lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by + rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 3 + +lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), + encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, + ← encTail_peelSep] + execute 4 + +lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, + encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 5 + +lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by + rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ + ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by + have htail : encTail ((k + 5, bR) :: R') = + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] + rw [cfg_M0_eq, htail] + have hw := A_wipe_ones (k + 3) (encTail L) (encTail (peelSep bR R')) + rw [zero_pow_wall k L] at hw + exact hw + +lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) + (hpre : start [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩) : + ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + by_cases h_rec : R' ≠ [] ∧ bR % 4 = 0 + · obtain ⟨hne, hb0⟩ := h_rec + rcases R' with _ | ⟨⟨a₂, b₂⟩, R''⟩ + · contradiction + · have hpost : start [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by + unfold P_cfg + rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + exact hpre + exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost + · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by + rcases R' with _ | ⟨r₂, rs⟩ + · exact Or.inl rfl + · exact Or.inr (fun h0 => h_rec ⟨by simp, h0⟩) + have hz : encTail (peelSep bR R') = (0 : Fin 2) >> encTail (peelInner bR R') := by + have hl := encRight_zero_peelInner bR R' hcond + rw [encRight_cons_eq_one_cons_encTail 0 bR R', encTail_zero_eq_zero_cons_peelSep] at hl + simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl + rcases h_in : peelInner bR R' with _ | ⟨⟨ai, bi⟩, rsi⟩ + · exact False.elim (peelInner_ne_nil bR R' h_in) + · rcases k with _ | _ | k' + · refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [hz, h_in] at hpre + have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + (encTail ((ai, bi) :: rsi)) + have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by + rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] + rfl + rw [hrhs] + exact stepPlus_trans hpre hp2 + · rw [hz, h_in] at hpre + have hp2 : start [target_tm]⊢⁺ + P_cfg L (([0] : List (Fin 2)) ^ k') ((0, 0) :: (ai, bi) :: rsi) := by + unfold P_cfg + rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] + dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, + listblank_append_nil, listblank_append_cons] at hpre ⊢ + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 + +lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := + A_wall_peelSep_closed L k bR R' (M0_add5_pre L k bR R') + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encRight ((0, c) :: tailAsRight R) := by + rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + rfl + +lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((1, c) :: tailAsRight R) := by + rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by + rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma RD_eq_encTail_two (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (1 : Fin 2) >> (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = + encTail ((2, c) :: tailAsRight R) := by + rw [encTail_succ 1, encTail_succ 0, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] + +lemma rD_eq_zero_cons_peelSep (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : + (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) = + (0 : Fin 2) >> encTail (peelSep c (tailAsRight R)) := by + rw [encTail_peelSep c (tailAsRight R), Nat.mod_eq_of_lt hc, encRight_tailAsRight, + zero_pow_one_add c, listblank_append_cons] + +lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 1 + +lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + execute 4 + +lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by + execute 4 + +lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : + (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by + execute 5 + +lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by + execute 1 + +lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ + (∃ c' L' R', c' < 4 ∧ L'.length < L.length ∧ cfg' = cfg_D c' L' R')) := by + unfold cfg_D + set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) + have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R + have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_two : (1 : Fin 2) >> (1 : Fin 2) >> rD = encTail ((2, c) :: tailAsRight R) := RD_eq_encTail_two c hc R + have hrD_peel : rD = (0 : Fin 2) >> encTail (peelSep c (tailAsRight R)) := rD_eq_zero_cons_peelSep c hc R + rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ + · -- L = [] + have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases a₁ with _ | _ | a₁' + · -- a₁ = 0 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · -- L = [(0, b₁)] + have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by + simp [encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 (encTail []) rD + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · -- b₁ % 4 = 0, L = (0, b₁) :: (a₂, b₂) :: L'' + rcases a₂ with _ | _ | a₂' + · -- a₂ = 0 + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · -- L = [(0, b₁), (0, b₂)] + have hL : encTail [(0, b₁), (0, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_zero, hb0] + rw [hL] + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, encTail_zero, zero_pow_one_add 0, pow_zero_list, + listblank_append_cons, listblank_append_nil, ← hrD_right] + have hd := D_leaf_0100 default rD + simpa using hd + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, + encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_one] + exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + · -- a₂ = 1 + rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' + have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + rfl + rw [hL] + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] + simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD + · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' + rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · have hL : encTail [(0, b₁), (1, b₂)] = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by + simp [encTail_zero, hb0, h23] + rw [hL] + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_tail] + simpa using D_leaf_011 default rD + · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h23, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + unfold P_cfg wall + rw [listblank_append_nil, ← hrD_right] + exact D_leaf_011 _ rD + · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) + have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD + · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by + rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] + rfl + rw [hL] + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb2, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' + have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = + (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by + rw [encTail_zero, hb3, encTail_zero] + rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, ← hrD_tail] + exact D_leaf_00 _ rD + · -- a₁ = 1 (F0 = 1LE -> 4-step and 7-step leaves!) + have h1000 : ∀ (tL : ListBlank (Fin 2)), + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by + intro tL; execute 4 + rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ + · have hL : encTail [(1, b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + simp [encTail_succ, encTail_zero] + rw [hL] + refine ⟨cfg_M0 [] ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil, ← hrD_two] + simpa using h1000 default + · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + have h7 : (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) <{{D}} rD) [target_tm]⊢⁺ + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂, b₂) :: L''), + encTail (peelSep c (tailAsRight R))⟩⟩ := by + rw [hrD_peel] + execute 7 + rcases a₂ with _ | a₂' + · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ + · refine ⟨cfg_M0 [] (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_nil] + have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail [(0, b₂)] = default := by + simp [encTail_zero] + rw [← h0] + exact h7 + · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 + · refine ⟨cfg_M0 ((0, 3) :: (a₃, b₃) :: L''') (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 3 ((a₃, b₃) :: L''')] + have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + (([0] : List (Fin 2)) ^ (1 + 3 % 4)) +> encRight ((a₃, b₃) :: L''') := by + rw [encTail_zero, h20]; rfl + rw [← h0] + exact h7 + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + (([0] : List (Fin 2)) ^ 0) +> wall ((a₃, b₃) :: L''') := by + rw [encTail_zero, h21, encRight_cons_eq_one_cons_encTail]; rfl + rw [h0] at h7 + obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 0 c (tailAsRight R) h7 + rcases hout with hM | hH + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + (([0] : List (Fin 2)) ^ 1) +> wall ((a₃, b₃) :: L''') := by + rw [encTail_zero, h22, encRight_cons_eq_one_cons_encTail]; rfl + rw [h0] at h7 + obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 1 c (tailAsRight R) h7 + rcases hout with hM | hH + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + (([0] : List (Fin 2)) ^ 2) +> wall ((a₃, b₃) :: L''') := by + rw [encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl + rw [h0] at h7 + obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 2 c (tailAsRight R) h7 + rcases hout with hM | hH + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · refine ⟨cfg_M0 ((0, 2) :: (a₂', b₂) :: L'') (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₂', b₂) :: L'')] + have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂' + 1, b₂) :: L'') = + (([0] : List (Fin 2)) ^ (1 + 2 % 4)) +> encRight ((a₂', b₂) :: L'') := by + rw [encTail_succ, encRight_cons_eq_one_cons_encTail]; rfl + rw [← h0] + exact h7 + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_D 1 ((a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (1, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + unfold cfg_D + dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, + listblank_append_cons, listblank_append_nil] + rw [← hrD_tail] + execute 4 + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + simpa using h1000 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) + · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail]; rfl + rw [hL] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + simpa using h1000 ((0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) + · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! + have hL : encTail ((a₁' + 2, b₁) :: L') = + (1 : Fin 2) >> (1 : Fin 2) >> encTail ((a₁', b₁) :: L') := by + rw [encTail_succ (a₁' + 1), encTail_succ a₁'] + rw [hL] + refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), + D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ + +theorem stage2_closed (n : ℕ) : + ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, + ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ + (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P)) := by + induction n with + | zero => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', _, hlt, _⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · omega + | succ n' ih => + intro L hlen c hc R + obtain ⟨cfg', hstep, hout⟩ := D_step_one c hc L R + rcases hout with hM | hH | hP | ⟨c', L', R', hc', hlt, rfl⟩ + · exact ⟨cfg', hstep, Or.inl hM⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ + · exact ⟨cfg', hstep, Or.inr (Or.inr hP)⟩ + · obtain ⟨cfg'', hstep2, hout2⟩ := ih L' (by omega) c' hc' R' + exact ⟨cfg'', stepPlus_trans hstep hstep2, hout2⟩ + +-- ============================================================================ + +-- ============================================================================ + + +theorem stage1_step_all (L R : List (ℕ × ℕ)) : + ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by + rcases R with _ | ⟨⟨d, bR⟩, R'⟩ + · exact ⟨_, M0_nil L, Or.inr (Or.inr ⟨L, [], rfl⟩)⟩ + · rcases d with _ | _ | _ | _ | _ | k + · exact ⟨_, M0_zero L bR R', Or.inr (Or.inr ⟨L, peelSep bR R', rfl⟩)⟩ + · exact ⟨_, M0_one L bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_two L bR R', Or.inl ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_three L bR R', Or.inl ⟨.M0, (0, 2) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · exact ⟨_, M0_four L bR R', Or.inl ⟨.M0, (0, 3) :: tailAsRight L, peelSep bR R', rfl⟩⟩ + · obtain ⟨cfg', h, hout⟩ := M0_add5_closed L k bR R' + rcases hout with hM | hH + · exact ⟨cfg', h, Or.inl hM⟩ + · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ + +theorem stack_system_closed : + ∀ cfg, IsInStackSystem cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by + intro cfg ⟨m, L, R, hcfg⟩ + subst hcfg + cases m with + | M0 => + obtain ⟨cfg₁, h₁, hout₁⟩ := stage1_step_all L R + rcases hout₁ with hM₁ | hH₁ | ⟨L₁, R₁, rfl⟩ + · exact ⟨cfg₁, h₁, Or.inl hM₁⟩ + · exact ⟨cfg₁, h₁, Or.inr hH₁⟩ + · obtain ⟨cfg₂, h₂, hout₂⟩ := stage2_closed L₁.length L₁ (Nat.le_refl _) 0 (by decide) R₁ + rcases hout₂ with hM₂ | hH₂ | ⟨L'', R_P, hRP, rfl⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inl hM₂⟩ + · exact ⟨cfg₂, stepPlus_trans h₁ h₂, Or.inr hH₂⟩ + · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP + exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_stack_cryptid : IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, + Or.inl ⟨rfl, rfl⟩, + rfl, rfl, audit_encLeft_head, audit_encRight_head, + audit_encLeft_not_surjective, audit_encRight_not_surjective, + ⟨1, 1, 1, 4, 1, 1, 1, 4, + by decide, by decide, by decide, by decide, by decide, + by decide, by decide, by decide, by decide, by decide, + fun a b L => rfl, fun d b R => rfl⟩, + ⟨[.M0], by decide, by intro m; cases m; decide⟩, + valid_stack_modes, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + init_reaches_stack_system, + stack_system_closed⟩ + +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH + diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean new file mode 100644 index 00000000..4c9f37f2 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean @@ -0,0 +1,663 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 4, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 1 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.left) + | 3, 1 => none + | 4, 0 => some (some 5, Stmt.write 1 Dir.left) + | 4, 1 => some (some 2, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => some (some 4, Stmt.write 1 Dir.left) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Three head modes of Holdout `#612` (`1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`). -/ +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +/-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), +forbidding `[0, 0, 0, 1]`. -/ +@[simp] +def lWord : ℕ × Bool → List (Fin 2) + | (0, false) => [1, 0] + | (d + 1, false) => 1 :: lWord (d, false) + | (0, true) => [1, 0, 0] + | (k + 1, true) => 1 :: 1 :: lWord (k, true) + +/-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | z + 1 => 0 :: zWord z + +@[simp] +def encLeft : List (ℕ × Bool) → zB + | [] => default + | p :: L => lWord p +> encLeft L + +@[simp] +def encRight : List ℕ → zB + | [] => default + | z :: R => zWord z +> encRight R + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +lemma evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encRight R := + evalSegRegion_zWord R + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + +lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by + have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := + WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + induction d with + | zero => + cases b <;> ( + simp only [lWord, ListBlank.append, zero_cons_default] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 + (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) + (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by + induction d with + | zero => + cases b with + | false => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + have h00 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> (0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) _ h0 2 (by decide) + (by rw [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h00 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_encLeft : + ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) + | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + | [(d, b)] => noFactor_0001_lWord_nil d b + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 0, 0, 1] + (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_0001_encLeft L) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encRight R)) {{0}}> (applyView (.id []) (encLeft L)) + | .mAR, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id []) (encLeft L)) + | .mA0, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id [0]) (encLeft L)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mCL => + refine ⟨0, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mAR => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mA0 => + refine ⟨4, .id [], .id [0], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mCL => exact ⟨0, applyView (.id []) (encLeft L), Or.inr (Or.inr rfl)⟩ + | mAR => exact ⟨4, applyView (.id []) (encLeft L), Or.inr (Or.inl rfl)⟩ + | mA0 => exact ⟨4, applyView (.id [0]) (encLeft L), Or.inr (Or.inl rfl)⟩ + +@[simp] +def bump2L : List (ℕ × Bool) → List (ℕ × Bool) + | [] => [(1, false)] + | (d, false) :: L => (d + 2, false) :: L + | (k, true) :: L => (k + 1, true) :: L + +@[simp] +def push0R : List ℕ → List ℕ + | [] => [] + | z :: R => (z + 1) :: R + +@[simp] +def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := + (encRight (0 :: R)) <{{3}} (encLeft L) + +@[simp] +def s₀ : SegState := (.mCL, [(0, false), (0, false)], [0]) + +lemma zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + +lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : + (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by + rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> + simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mCL [(0, false), (0, false)] [0] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +lemma step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_0_halt (Rt : List ℕ) : + (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : + (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 [(0, false)] (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_nil (R : List ℕ) : + (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by + cases d <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by + cases k <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((d, false) :: L) (push0R R) := by + cases d <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by + cases k <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by + induction k generalizing R with + | zero => + simp only [push00IterR] + exact step_mCL_0_true L R + | succ k ih => + simp only [push00IterR] + exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) + +-- Mode mAR (0>) transitions +lemma step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, false) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +-- Mode mA0 (0> with leading 0) transitions +lemma step_mA0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, true) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mCL => + rcases L with _ | ⟨⟨_ | d, _ | _⟩, Ls⟩ + · rcases R with _ | ⟨_ | z, Rt⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], []), step_mCL_nil_nil, + Or.inl ⟨(.mA0, [(0, false)], []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt [(0, false)] Rt, step_mCL_nil_0_halt Rt, + Or.inr (step_cfgHalt_isNone [(0, false)] Rt)⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], z :: Rt), step_mCL_nil_succ z Rt, + Or.inl ⟨(.mA0, [(0, false)], z :: Rt), trivial, rfl⟩⟩ + · rcases Ls with _ | ⟨⟨_ | _ | d2, _ | _⟩, Lss⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], R), step_mCL_0_false_nil R, + Or.inl ⟨(.mA0, [(0, false)], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, Lss, 1 :: 0 :: push0R R), step_mCL_0_false_0_false Lss R, + Or.inl ⟨(.mCL, Lss, 1 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), + step_mCL_0_false_0_true Lss R, + Or.inl ⟨(.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_1_false Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_succ_true 0 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), + step_mCL_0_false_succ2_false d2 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), + step_mCL_0_false_succ_true (d2 + 1) Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, R), step_mCL_true_sweep 0 Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (d, false) :: Ls, push0R R), step_mCL_succ_false d Ls R, + Or.inl ⟨(.mCL, (d, false) :: Ls, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, push00IterR (d + 1) R), + step_mCL_true_sweep (d + 1) Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, push00IterR (d + 1) R), trivial, rfl⟩⟩ + | mAR => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, L, [1]), step_mAR_nil L, Or.inl ⟨(.mCL, L, [1]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, []), step_mAR_0_nil L, + Or.inl ⟨(.mAR, (0, false) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, []), step_mAR_0_0_nil L, + Or.inl ⟨(.mA0, (0, false) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, false) :: L) Rt3, step_mAR_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, false) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, z3 :: Rt3), step_mAR_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, false) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, z2 :: Rt2), step_mAR_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, false) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, bump2L L, Rt), step_mAR_1_cons L Rt, + Or.inl ⟨(.mAR, bump2L L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, 1 :: z :: Rt), step_mAR_succ2 z L Rt, + Or.inl ⟨(.mCL, L, 1 :: z :: Rt), trivial, rfl⟩⟩ + | mA0 => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, [0]), step_mA0_nil L, + Or.inl ⟨(.mCL, (0, false) :: L, [0]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, []), step_mA0_0_nil L, + Or.inl ⟨(.mAR, (0, true) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, []), step_mA0_0_0_nil L, + Or.inl ⟨(.mA0, (0, true) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, true) :: L) Rt3, step_mA0_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, true) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, z3 :: Rt3), step_mA0_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, true) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, z2 :: Rt2), step_mA0_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, true) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (1, false) :: L, Rt), step_mA0_1_cons L Rt, + Or.inl ⟨(.mAR, (1, false) :: L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, + Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean new file mode 100644 index 00000000..9e81c0f5 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean @@ -0,0 +1,664 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 0, Stmt.write 1 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.right) + | 3, 1 => some (some 0, Stmt.write 0 Dir.left) + | 4, 0 => some (some 0, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.right) + | 5, 0 => some (some 0, Stmt.write 0 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Three head modes of Holdout `#533` (`1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`). -/ +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +/-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), +forbidding `[0, 0, 0, 1]`. -/ +@[simp] +def lWord : ℕ × Bool → List (Fin 2) + | (0, false) => [1, 0] + | (d + 1, false) => 1 :: lWord (d, false) + | (0, true) => [1, 0, 0] + | (k + 1, true) => 1 :: 1 :: lWord (k, true) + +/-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | z + 1 => 0 :: zWord z + +@[simp] +def encLeft : List (ℕ × Bool) → zB + | [] => default + | p :: L => lWord p +> encLeft L + +@[simp] +def encRight : List ℕ → zB + | [] => default + | z :: R => zWord z +> encRight R + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +lemma evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_zWord R + +lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + +lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by + have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := + WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + induction d with + | zero => + cases b <;> ( + simp only [lWord, ListBlank.append, zero_cons_default] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 + (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) + (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by + induction d with + | zero => + cases b with + | false => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + have h00 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> (0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) _ h0 2 (by decide) + (by rw [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h00 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_encLeft : + ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) + | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + | [(d, b)] => noFactor_0001_lWord_nil d b + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 0, 1] + (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_0001_encLeft L) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id []) (encRight R)) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mA0, L, R => (applyView (.id [0]) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mCL => + refine ⟨2, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mAR => + refine ⟨0, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mA0 => + refine ⟨0, .id [0], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + +lemma segsR_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vL, + (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = vL {{q}}> (evalSegmentedHalf (segsR s))) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsR] + cases m with + | mCL => exact ⟨2, applyView (.id []) (encLeft L), Or.inr (Or.inl rfl)⟩ + | mAR => exact ⟨0, applyView (.id []) (encLeft L), Or.inr (Or.inr rfl)⟩ + | mA0 => exact ⟨0, applyView (.id [0]) (encLeft L), Or.inr (Or.inr rfl)⟩ + +@[simp] +def bump2L : List (ℕ × Bool) → List (ℕ × Bool) + | [] => [(1, false)] + | (d, false) :: L => (d + 2, false) :: L + | (k, true) :: L => (k + 1, true) :: L + +@[simp] +def push0R : List ℕ → List ℕ + | [] => [] + | z :: R => (z + 1) :: R + +@[simp] +def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := + (encLeft L) {{5}}> (encRight (0 :: R)) + +@[simp] +def s₀ : SegState := (.mCL, [(0, false)], [0]) + +lemma zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + +lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : + (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by + rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> + simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mCL [(0, false)] [0] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +lemma step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_0_halt (Rt : List ℕ) : + (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : + (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 [(0, false)] (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_nil (R : List ℕ) : + (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by + cases d <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by + cases k <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((d, false) :: L) (push0R R) := by + cases d <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by + cases k <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by + induction k generalizing R with + | zero => + simp only [push00IterR] + exact step_mCL_0_true L R + | succ k ih => + simp only [push00IterR] + exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) + +-- Mode mAR (0>) transitions +lemma step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, false) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +-- Mode mA0 (0> with leading 0) transitions +lemma step_mA0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, true) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mCL => + rcases L with _ | ⟨⟨_ | d, _ | _⟩, Ls⟩ + · rcases R with _ | ⟨_ | z, Rt⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], []), step_mCL_nil_nil, + Or.inl ⟨(.mA0, [(0, false)], []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt [(0, false)] Rt, step_mCL_nil_0_halt Rt, + Or.inr (step_cfgHalt_isNone [(0, false)] Rt)⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], z :: Rt), step_mCL_nil_succ z Rt, + Or.inl ⟨(.mA0, [(0, false)], z :: Rt), trivial, rfl⟩⟩ + · rcases Ls with _ | ⟨⟨_ | _ | d2, _ | _⟩, Lss⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], R), step_mCL_0_false_nil R, + Or.inl ⟨(.mA0, [(0, false)], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, Lss, 1 :: 0 :: push0R R), step_mCL_0_false_0_false Lss R, + Or.inl ⟨(.mCL, Lss, 1 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), + step_mCL_0_false_0_true Lss R, + Or.inl ⟨(.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_1_false Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_succ_true 0 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), + step_mCL_0_false_succ2_false d2 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), + step_mCL_0_false_succ_true (d2 + 1) Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, R), step_mCL_true_sweep 0 Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (d, false) :: Ls, push0R R), step_mCL_succ_false d Ls R, + Or.inl ⟨(.mCL, (d, false) :: Ls, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, push00IterR (d + 1) R), + step_mCL_true_sweep (d + 1) Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, push00IterR (d + 1) R), trivial, rfl⟩⟩ + | mAR => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, L, [1]), step_mAR_nil L, Or.inl ⟨(.mCL, L, [1]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, []), step_mAR_0_nil L, + Or.inl ⟨(.mAR, (0, false) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, []), step_mAR_0_0_nil L, + Or.inl ⟨(.mA0, (0, false) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, false) :: L) Rt3, step_mAR_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, false) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, z3 :: Rt3), step_mAR_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, false) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, z2 :: Rt2), step_mAR_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, false) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, bump2L L, Rt), step_mAR_1_cons L Rt, + Or.inl ⟨(.mAR, bump2L L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, 1 :: z :: Rt), step_mAR_succ2 z L Rt, + Or.inl ⟨(.mCL, L, 1 :: z :: Rt), trivial, rfl⟩⟩ + | mA0 => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, [0]), step_mA0_nil L, + Or.inl ⟨(.mCL, (0, false) :: L, [0]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, []), step_mA0_0_nil L, + Or.inl ⟨(.mAR, (0, true) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, []), step_mA0_0_0_nil L, + Or.inl ⟨(.mA0, (0, true) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, true) :: L) Rt3, step_mA0_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, true) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, z3 :: Rt3), step_mA0_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, true) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, z2 :: Rt2), step_mA0_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, true) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (1, false) :: L, Rt), step_mA0_1_cons L Rt, + Or.inl ⟨(.mAR, (1, false) :: L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, + Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inl segsL_nowhere_dense, + Or.inl segsL_nowhere_dense, + Or.inr segsR_boundary_aligned, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean new file mode 100644 index 00000000..ac5fa984 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean @@ -0,0 +1,595 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => none + | 2, 0 => some (some 3, Stmt.write 0 Dir.right) + | 2, 1 => some (some 2, Stmt.write 0 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 3, Stmt.write 1 Dir.left) + | 4, 1 => some (some 0, Stmt.write 1 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.right) + | 5, 1 => some (some 5, Stmt.write 0 Dir.left) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#439` (`1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{5}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{2}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{4}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{4}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨5, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨2, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨4, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨3, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨3, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨5, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨2, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨4, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨4, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨3, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨3, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{1}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mB0, [0, 0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0, 0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, []), step_mD0_nil L, + Or.inl ⟨(.mCL1, 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, []), step_mD1_nil L, + Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt (1 :: L) o R, step_mD1_1_to_halt o L R, + Or.inr (step_cfgHalt_isNone o (1 :: L) R)⟩ + · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ +end BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean new file mode 100644 index 00000000..f257f6a1 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean @@ -0,0 +1,588 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => none + | 2, 0 => some (some 5, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 1 Dir.left) + | 3, 0 => some (some 4, Stmt.write 1 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.left) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#560` (`1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_zWord L + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{4}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft L)) {{5}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft L)) {{5}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨5, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨5, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨2, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨2, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨3, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨4, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨5, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨5, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨2, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨2, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{1}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mCL1, [0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mCL1 [0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt L o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mAL L ((1, 0) :: (z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, 1 :: L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, L, []), step_mD0_nil L, Or.inl ⟨(.mCL1, L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mAL, L, [(1, 0)]), step_mD1_nil L, + Or.inl ⟨(.mAL, L, [(1, 0)]), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt L o R, step_mD1_1_to_halt o L R, Or.inr (step_cfgHalt_isNone o L R)⟩ + · exact ⟨evalCfg (.mAL, L, (1, 0) :: (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mAL, L, (1, 0) :: (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean new file mode 100644 index 00000000..118a300d --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean @@ -0,0 +1,596 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => none + | 2, 0 => some (some 3, Stmt.write 1 Dir.right) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.left) + | 4, 1 => some (some 2, Stmt.write 1 Dir.left) + | 5, 0 => some (some 4, Stmt.write 1 Dir.left) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#729` (`1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{5}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{5}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨2, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨5, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨5, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨4, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨4, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨2, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨3, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨5, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨5, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨4, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨4, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{1}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mB0, [1, 0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [1, 0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, []), step_mD0_nil L, + Or.inl ⟨(.mCL1, 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mAL, L, [(1, 2)]), step_mD1_nil L, + Or.inl ⟨(.mAL, L, [(1, 2)]), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt (1 :: L) o R, step_mD1_1_to_halt o L R, + Or.inr (step_cfgHalt_isNone o (1 :: L) R)⟩ + · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA diff --git a/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean new file mode 100644 index 00000000..a6e9a062 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean @@ -0,0 +1,663 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 1 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => some (some 0, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 1, Stmt.write 1 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 0, Stmt.write 0 Dir.right) + | 4, 1 => some (some 1, Stmt.write 0 Dir.left) + | 5, 0 => some (some 1, Stmt.write 0 Dir.right) + | 5, 1 => none + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Three head modes of Holdout `#119` (`1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`). -/ +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +/-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), +forbidding `[0, 0, 0, 1]`. -/ +@[simp] +def lWord : ℕ × Bool → List (Fin 2) + | (0, false) => [1, 0] + | (d + 1, false) => 1 :: lWord (d, false) + | (0, true) => [1, 0, 0] + | (k + 1, true) => 1 :: 1 :: lWord (k, true) + +/-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | z + 1 => 0 :: zWord z + +@[simp] +def encLeft : List (ℕ × Bool) → zB + | [] => default + | p :: L => lWord p +> encLeft L + +@[simp] +def encRight : List ℕ → zB + | [] => default + | z :: R => zWord z +> encRight R + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +lemma evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_zWord R + +lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + +lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by + have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := + WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + induction d with + | zero => + cases b <;> ( + simp only [lWord, ListBlank.append, zero_cons_default] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 + (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) + (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : + WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by + induction d with + | zero => + cases b with + | false => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) + (by rw [WordRunStack.nth_cons_succ, ht0]; decide) + have h00 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> (0 : Fin 2) >> t) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) _ h0 2 (by decide) + (by rw [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_succ, ht0]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h00 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ d ih => + cases b with + | false => + simp only [lWord, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | true => + simp only [lWord, ListBlank.append] + have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := + WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_0001_encLeft : + ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) + | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) + | [(d, b)] => noFactor_0001_lWord_nil d b + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 0, 1] + (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_0001_encLeft L) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id []) (encRight R)) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mA0, L, R => (applyView (.id [0]) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mCL => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mAR => + refine ⟨1, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mA0 => + refine ⟨1, .id [0], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + +lemma segsR_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vL, + (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = vL {{q}}> (evalSegmentedHalf (segsR s))) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsR] + cases m with + | mCL => exact ⟨3, applyView (.id []) (encLeft L), Or.inr (Or.inl rfl)⟩ + | mAR => exact ⟨1, applyView (.id []) (encLeft L), Or.inr (Or.inr rfl)⟩ + | mA0 => exact ⟨1, applyView (.id [0]) (encLeft L), Or.inr (Or.inr rfl)⟩ + +@[simp] +def bump2L : List (ℕ × Bool) → List (ℕ × Bool) + | [] => [(1, false)] + | (d, false) :: L => (d + 2, false) :: L + | (k, true) :: L => (k + 1, true) :: L + +@[simp] +def push0R : List ℕ → List ℕ + | [] => [] + | z :: R => (z + 1) :: R + +@[simp] +def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := + (encLeft L) {{5}}> (encRight (0 :: R)) + +@[simp] +def s₀ : SegState := (.mAR, [(0, false)], []) + +lemma zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + +lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : + (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by + rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> + simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mAR [(0, false)] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +lemma step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_0_halt (Rt : List ℕ) : + (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : + (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 [(0, false)] (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_nil (R : List ℕ) : + (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by + cases d <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by + cases k <;> ( + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) R := by + simp only [evalSegCfg, applyView, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((d, false) :: L) (push0R R) := by + cases d <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by + cases k <;> ( + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : + (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by + induction k generalizing R with + | zero => + simp only [push00IterR] + exact step_mCL_0_true L R + | succ k ih => + simp only [push00IterR] + exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) + +-- Mode mAR (0>) transitions +lemma step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, false) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL L (1 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +-- Mode mA0 (0> with leading 0) transitions +lemma step_mA0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ + cfgHalt ((0, true) :: L) Rt := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : + (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by + simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mCL => + rcases L with _ | ⟨⟨_ | d, _ | _⟩, Ls⟩ + · rcases R with _ | ⟨_ | z, Rt⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], []), step_mCL_nil_nil, + Or.inl ⟨(.mA0, [(0, false)], []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt [(0, false)] Rt, step_mCL_nil_0_halt Rt, + Or.inr (step_cfgHalt_isNone [(0, false)] Rt)⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], z :: Rt), step_mCL_nil_succ z Rt, + Or.inl ⟨(.mA0, [(0, false)], z :: Rt), trivial, rfl⟩⟩ + · rcases Ls with _ | ⟨⟨_ | _ | d2, _ | _⟩, Lss⟩ + · exact ⟨evalCfg (.mA0, [(0, false)], R), step_mCL_0_false_nil R, + Or.inl ⟨(.mA0, [(0, false)], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, Lss, 1 :: 0 :: push0R R), step_mCL_0_false_0_false Lss R, + Or.inl ⟨(.mCL, Lss, 1 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), + step_mCL_0_false_0_true Lss R, + Or.inl ⟨(.mCL, (0, false) :: Lss, 0 :: 0 :: push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_1_false Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), + step_mCL_0_false_succ_true 0 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (0, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), + step_mCL_0_false_succ2_false d2 Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2, false) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), + step_mCL_0_false_succ_true (d2 + 1) Lss R, + Or.inl ⟨(.mAR, (0, false) :: (0, false) :: (d2 + 1, true) :: Lss, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, R), step_mCL_true_sweep 0 Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (d, false) :: Ls, push0R R), step_mCL_succ_false d Ls R, + Or.inl ⟨(.mCL, (d, false) :: Ls, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: Ls, push00IterR (d + 1) R), + step_mCL_true_sweep (d + 1) Ls R, + Or.inl ⟨(.mA0, (0, false) :: Ls, push00IterR (d + 1) R), trivial, rfl⟩⟩ + | mAR => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, L, [1]), step_mAR_nil L, Or.inl ⟨(.mCL, L, [1]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, []), step_mAR_0_nil L, + Or.inl ⟨(.mAR, (0, false) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, []), step_mAR_0_0_nil L, + Or.inl ⟨(.mA0, (0, false) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, false) :: L) Rt3, step_mAR_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, false) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, false) :: L, z3 :: Rt3), step_mAR_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, false) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, false) :: L, z2 :: Rt2), step_mAR_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, false) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, bump2L L, Rt), step_mAR_1_cons L Rt, + Or.inl ⟨(.mAR, bump2L L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, 1 :: z :: Rt), step_mAR_succ2 z L Rt, + Or.inl ⟨(.mCL, L, 1 :: z :: Rt), trivial, rfl⟩⟩ + | mA0 => + rcases R with _ | ⟨_ | _ | z, Rt⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, [0]), step_mA0_nil L, + Or.inl ⟨(.mCL, (0, false) :: L, [0]), trivial, rfl⟩⟩ + · rcases Rt with _ | ⟨_ | z2, Rt2⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, []), step_mA0_0_nil L, + Or.inl ⟨(.mAR, (0, true) :: L, []), trivial, rfl⟩⟩ + · rcases Rt2 with _ | ⟨_ | z3, Rt3⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, []), step_mA0_0_0_nil L, + Or.inl ⟨(.mA0, (0, true) :: L, []), trivial, rfl⟩⟩ + · exact ⟨cfgHalt ((0, true) :: L) Rt3, step_mA0_0_0_0_halt L Rt3, + Or.inr (step_cfgHalt_isNone ((0, true) :: L) Rt3)⟩ + · exact ⟨evalCfg (.mA0, (0, true) :: L, z3 :: Rt3), step_mA0_0_0_succ z3 L Rt3, + Or.inl ⟨(.mA0, (0, true) :: L, z3 :: Rt3), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0, true) :: L, z2 :: Rt2), step_mA0_0_succ z2 L Rt2, + Or.inl ⟨(.mAR, (0, true) :: L, z2 :: Rt2), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (1, false) :: L, Rt), step_mA0_1_cons L Rt, + Or.inl ⟨(.mAR, (1, false) :: L, Rt), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, + Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inl segsL_nowhere_dense, + Or.inl segsL_nowhere_dense, + Or.inr segsR_boundary_aligned, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean new file mode 100644 index 00000000..00ba2320 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean @@ -0,0 +1,595 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 4, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.right) + | 4, 0 => some (some 1, Stmt.write 1 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => some (some 3, Stmt.write 0 Dir.right) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +open Counter + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#402` (`1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mB0 => + refine ⟨1, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD0 => + refine ⟨3, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mD1 => + refine ⟨3, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL => + refine ⟨2, .id [], .id [1, 1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL1 => + refine ⟨2, .id [], .id [1], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + +lemma segsL_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vR, + (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ + (evalCfg s = (evalSegmentedHalf (segsL s)) {{q}}> vR) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsL] + cases m with + | mAL => exact ⟨4, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mB0 => exact ⟨1, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD0 => exact ⟨3, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mD1 => exact ⟨3, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL => exact ⟨2, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL1 => exact ⟨2, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) {{0}}> (oRun o +> encRight R) + +@[simp] +def s₀ : SegState := (.mB0, [0], []) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + execute + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, []), step_mD0_nil L, + Or.inl ⟨(.mCL1, 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, []), step_mD1_nil L, + Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt (1 :: L) o R, step_mD1_1_to_halt o L R, + Or.inr (step_cfgHalt_isNone o (1 :: L) R)⟩ + · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inr segsR_nowhere_dense, + Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ +end BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean new file mode 100644 index 00000000..53d48d87 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean @@ -0,0 +1,603 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 0 Dir.left) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 1 Dir.right) + | 3, 1 => some (some 1, Stmt.write 1 Dir.right) + | 4, 0 => some (some 3, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => some (some 4, Stmt.write 0 Dir.left) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 400000 +set_option maxRecDepth 10000 + +@[simp] lemma default_head : (default : zB).head = 0 := rfl +@[simp] lemma default_tail : (default : zB).tail = default := rfl + +open Counter + +local macro "finish" : tactic => `(tactic| first | exact ⟨0, rfl⟩ | (exists 0 <;> fail)) +local macro "gstep" : tactic => + `(tactic| (try refine stepPlus_stepStar ?_) <;> + refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, + zero_cons_default, default_head, default_tail]) +local macro "step" : tactic => `(tactic| gstep) +local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) +local macro "execute" : tactic => + `(tactic| (step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1; step1)) + +/-- Six head modes of Holdout `#729` (`1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`). -/ +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +/-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ +@[simp] +def zWord : ℕ → List (Fin 2) + | 0 => [1] + | k + 1 => 0 :: zWord k + +/-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ +@[simp] +def oRun : ℕ → List (Fin 2) + | 0 => [1, 1] + | o + 1 => 1 :: oRun o + +/-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ +@[simp] +def rWord : ℕ × ℕ → List (Fin 2) + | (0, o) => oRun o + | (z + 1, o) => 0 :: rWord (z, o) + +@[simp] +def encLeft : List ℕ → zB + | [] => default + | k :: L => zWord k +> encLeft L + +@[simp] +def encRight : List (ℕ × ℕ) → zB + | [] => default + | p :: R => rWord p +> encRight R + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +@[simp] +def modeOf (s : SegState) : SegMode := s.1 + +@[simp] +def ValidSeg (_ : SegState) : Prop := True + +@[simp] +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +@[simp] +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +@[simp] +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : + (a ++ b) +> s = a +> (b +> s) := by + induction a with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encRight R := + evalSegRegion_rWord R + +@[simp] +lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + +lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by + induction o with + | zero => + simp only [oRun, ListBlank.append] + have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + | succ o ih => + simp only [oRun, ListBlank.append] + exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) + (by rw [WordRunStack.nth_cons_zero]; decide) + +lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : + WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by + induction z with + | zero => + simp only [rWord] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ + rw [WordRunStack.nth_cons_succ, oRun_nth_one] + decide + | succ z => + simp only [rWord, ListBlank.append] at ih ⊢ + refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ + simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + decide + +lemma noFactor_010_encRight : + ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) + | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) + | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) + +lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := + WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 1, 0] + (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_010_encRight R) + +lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by + simp [segsL, segsR] + +@[simp] +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encRight R)) {{1}}> (applyView (.id []) (encLeft L)) + | .mB0, L, R => (applyView (.id []) (encRight R)) <{{2}} (applyView (.id []) (encLeft L)) + | .mD0, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id []) (encLeft (1 :: L))) + | .mD1, L, R => (applyView (.id [1]) (encRight R)) <{{4}} (applyView (.id []) (encLeft (1 :: L))) + | .mCL, L, R => (applyView (.id [1, 1]) (encRight R)) {{3}}> (applyView (.id []) (encLeft L)) + | .mCL1, L, R => (applyView (.id [1]) (encRight R)) {{3}}> (applyView (.id []) (encLeft L)) + +@[simp] +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +lemma valid_seg_modes : + ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s : SegState, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨0, + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) <{{q}} + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = (applyView vL (evalSegmentedHalf (segsL s))) {{q}}> + (applyView vR (evalSegmentedHalf (segsR s)))) := by + intro m + cases m with + | mAL => + refine ⟨1, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mB0 => + refine ⟨2, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mD0 => + refine ⟨4, .id [], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mD1 => + refine ⟨4, .id [1], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inl rfl) + | mCL => + refine ⟨3, .id [1, 1], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + | mCL1 => + refine ⟨3, .id [1], .id [], by decide, by decide, ?_⟩ + rintro ⟨_, L, R⟩ _ rfl + rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] + exact Or.inr (Or.inr rfl) + +lemma segsR_boundary_aligned : + ∀ s : SegState, ValidSeg s → ∃ q vL, + (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = vL {{q}}> (evalSegmentedHalf (segsR s))) := by + rintro ⟨m, L, R⟩ _ + rw [evalSegmentedHalf_segsR] + cases m with + | mAL => exact ⟨1, applyView (.id []) (encRight R), Or.inr (Or.inr rfl)⟩ + | mB0 => exact ⟨2, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mD0 => exact ⟨4, applyView (.id []) (encRight R), Or.inr (Or.inl rfl)⟩ + | mD1 => exact ⟨4, applyView (.id [1]) (encRight R), Or.inr (Or.inl rfl)⟩ + | mCL => exact ⟨3, applyView (.id [1, 1]) (encRight R), Or.inr (Or.inr rfl)⟩ + | mCL1 => exact ⟨3, applyView (.id [1]) (encRight R), Or.inr (Or.inr rfl)⟩ + +@[simp] +def push0L : List ℕ → List ℕ + | [] => [] + | k :: L => (k + 1) :: L + +@[simp] +def push0IterL : ℕ → List ℕ → List ℕ + | 0, L => L + | n + 1, L => push0IterL n (push0L L) + +@[simp] +def push0R : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (z, o) :: R => (z + 1, o) :: R + +@[simp] +def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + (oRun o +> encRight R) <{{0}} ((1 : Fin 2) >> (1 : Fin 2) >> encLeft L) + +@[simp] +def s₀ : SegState := (.mB0, [0, 0, 0], [(0, 2)]) + +lemma init_reaches_segmented_system : + (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0, 0, 0] [(0, 2)] := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init] + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail] + step; step; step; step; step; step; step; step; step; step + step; step; step; step; step; step; step; step; step; step + step; step; step; step; step; step; step; step; step; step + finish + +lemma step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by + rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L (push0L L)) R := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by + cases L <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (push0IterL (o + 2) L) R := by + induction o generalizing L with + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [Nat.succ_add, push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by + cases o <;> ( + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute) + +lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL L ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ + evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft, encRight, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ + evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by + simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + +lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ + evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by + simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default, default_head, default_tail]; execute + +theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by + cases m with + | mAL => + rcases L with _ | ⟨_ | k, L⟩ + · exact ⟨evalCfg (.mB0, [0], R), step_mAL_nil R, Or.inl ⟨(.mB0, [0], R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, push0R R), step_mAL_0 L R, + Or.inl ⟨(.mAL, L, push0R R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: k :: L, R), step_mAL_succ k L R, + Or.inl ⟨(.mB0, 0 :: k :: L, R), trivial, rfl⟩⟩ + | mB0 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL, L, []), step_mB0_nil L, Or.inl ⟨(.mCL, L, []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, push0IterL (o + 2) L, R), step_mB0_0_sweep o L R, + Or.inl ⟨(.mB0, push0IterL (o + 2) L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mB0, 0 :: L, (0, o) :: R), step_mB0_1 o L R, + Or.inl ⟨(.mB0, 0 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, L, (z, o) :: R), step_mB0_succ2 z o L R, + Or.inl ⟨(.mCL, L, (z, o) :: R), trivial, rfl⟩⟩ + | mCL => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL, [], (0, 0) :: R), step_mCL_nil R, + Or.inl ⟨(.mCL, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 1) :: R), step_mCL_0 L R, + Or.inl ⟨(.mAL, L, (0, 1) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, L, (0, 0) :: R), step_mCL_1 L R, + Or.inl ⟨(.mD0, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL, k :: L, (0, 0) :: R), step_mCL_succ2 k L R, + Or.inl ⟨(.mCL, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mCL1 => + rcases L with _ | ⟨_ | _ | k, L⟩ + · exact ⟨evalCfg (.mCL1, [], (0, 0) :: R), step_mCL1_nil R, + Or.inl ⟨(.mCL1, [], (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAL, L, (0, 0) :: R), step_mCL1_0 L R, + Or.inl ⟨(.mAL, L, (0, 0) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, L, R), step_mCL1_1 L R, + Or.inl ⟨(.mD1, L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, k :: L, (0, 0) :: R), step_mCL1_succ2 k L R, + Or.inl ⟨(.mCL1, k :: L, (0, 0) :: R), trivial, rfl⟩⟩ + | mD0 => + rcases R with _ | ⟨⟨_ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, []), step_mD0_nil L, + Or.inl ⟨(.mCL1, 1 :: L, []), trivial, rfl⟩⟩ + · rcases o with _ | _ | o + · exact ⟨evalCfg (.mD0, 1 :: L, R), step_mD0_00 L R, + Or.inl ⟨(.mD0, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD0_01 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD0_0_succ2 o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mCL1, 1 :: L, (z, o) :: R), step_mD0_succ z o L R, + Or.inl ⟨(.mCL1, 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ + | mD1 => + rcases R with _ | ⟨⟨_ | _ | z, o⟩, R⟩ + · exact ⟨evalCfg (.mAL, L, [(1, 2)]), step_mD1_nil L, + Or.inl ⟨(.mAL, L, [(1, 2)]), trivial, rfl⟩⟩ + · rcases o with _ | o + · exact ⟨evalCfg (.mD1, 1 :: L, R), step_mD1_00 L R, + Or.inl ⟨(.mD1, 1 :: L, R), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mD0, 1 :: L, (0, o) :: R), step_mD1_0_succ o L R, + Or.inl ⟨(.mD0, 1 :: L, (0, o) :: R), trivial, rfl⟩⟩ + · exact ⟨cfgHalt (1 :: L) o R, step_mD1_1_to_halt o L R, + Or.inr (step_cfgHalt_isNone o (1 :: L) R)⟩ + · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, + Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ + +theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := + segmented_step_sound s.1 s.2.1 s.2.2 + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by + exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, + ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, + segs_len_le_three, + valid_seg_modes, + Or.inl segsL_nowhere_dense, + Or.inl segsL_nowhere_dense, + Or.inr segsR_boundary_aligned, + ⟨s₀, trivial, init_reaches_segmented_system⟩, + segmented_system_closed⟩ + +end BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean new file mode 100644 index 00000000..9ee857bd --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean @@ -0,0 +1,528 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge +public import BusyBeaver.Calculi.Counter +public import BusyBeaver.Stack +public import BusyBeaver.WordRunStack + +@[expose] public section + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.style.multiGoal false +set_option linter.deprecated false +set_option linter.flexible false + +/-! +# Busy Beaver Machine `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` — `is_odometer_cryptid` (`IsOdometerCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => some (some 4, Stmt.write 0 Dir.left) + | 2, 0 => some (some 3, Stmt.write 0 Dir.left) + | 2, 1 => some (some 5, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 0 Dir.right) + | 4, 0 => some (some 2, Stmt.write 0 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.left) + | 5, 0 => some (some 3, Stmt.write 1 Dir.right) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +-- END TRUSTED DEFINITIONS + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +local notation "zB" => ListBlank (Fin 2) +set_option linter.unusedSimpArgs false +set_option linter.unusedTactic false +set_option linter.unusedVariables false +set_option maxHeartbeats 2000000 +set_option maxRecDepth 10000 + +@[simp] lemma zMz (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 0 = some config := rfl +@[simp] lemma zMo (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 1 = step M config := rfl +@[simp] lemma zMs (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : Nat) : + multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by + rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] + +@[simp] lemma z00 : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl + +@[simp] lemma zDh : (default : zB).head = 0 := rfl +@[simp] lemma zDt : (default : zB).tail = default := rfl + +lemma zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] + +lemma z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢⁺ c₂ := + ⟨1, by decide, zSm tm c₁ c₂ h⟩ + +lemma zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ : Cfg Γ Λ) (n m : Nat) : + multiStep tm c₁ (n + m) = (multiStep tm c₁ n).bind (fun c₂ => multiStep tm c₂ m) := by + induction m with + | zero => simp + | succ m' ih => rw [Nat.add_succ, zMs, ih, Option.bind_assoc]; simp_rw [zMs] + +lemma zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ c3 : Cfg Γ Λ) (n m : Nat) + (h1 : c₁ [tm]⊢^{n} c₂) (h2 : c₂ [tm]⊢^{m} c3) : c₁ [tm]⊢^{n+m} c3 := by + rw [zMa, h1]; simp [h2] + +lemma zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ : Cfg Γ Λ} (h : c₁ [tm]⊢⁺ c₂) : c₁ [tm]⊢* c₂ := by + obtain ⟨n, _, hn⟩ := h; exact ⟨n, hn⟩ + +lemma z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := by + obtain ⟨n, n_pos, hn⟩ := h1; obtain ⟨m, hm⟩ := h2 + exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c₁ c₂ c3 n m hn hm⟩ + +lemma z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := + z02 (z01 tm c₁ c₂ h1) h2 + +lemma zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} + (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢⁺ c3) : c₁ [tm]⊢⁺ c3 := + z02 h1 (zPs h2) + +local macro "finish" : tactic => `(tactic| exists 0 <;> fail) +local macro "gstep" : tactic => + `(tactic| (try refine zPs ?_) <;> + refine z03 (by (try simp only [Turing.ListBlank.head_cons, zDh]); rfl) ?_ <;> + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, z00, zDh, zDt]) +local macro "execute" : tactic => `(tactic| repeat (any_goals (first | finish | gstep))) + +lemma fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by + match b with + | ⟨0, _⟩ => left; rfl + | ⟨1, _⟩ => right; rfl + +inductive OdomTok where + | L0 + | L1 + | L2 +deriving DecidableEq, Repr + +@[simp] +def odomWord : OdomTok → List (Fin 2) + | .L0 => [0, 0, 1, 0] + | .L1 => [1, 0, 1, 0] + | .L2 => [1, 1, 0] + +@[simp] +def encOdom : List OdomTok → zB + | [] => [1] +> default + | t :: l => odomWord t +> encOdom l + +lemma encOdom_non_surjective : + ∃ t : zB, ∀ stk : List OdomTok, encOdom stk ≠ t := by + refine ⟨default, fun stk h => ?_⟩ + cases stk with + | nil => + have h1 : (encOdom []).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + | cons t tl => + cases t with + | L0 => + have h1 : (encOdom (.L0 :: tl)).tail.tail.head = (default : zB).tail.tail.head := + congrArg (fun x => x.tail.tail.head) h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, zDt, zDh] at h1 + revert h1; decide + | L1 => + have h1 : (encOdom (.L1 :: tl)).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + | L2 => + have h1 : (encOdom (.L2 :: tl)).head = (default : zB).head := congrArg ListBlank.head h + simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 + revert h1; decide + +@[simp] def state_R (_ : List OdomTok) : Fin 6 := 3 + +@[simp] def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomR .leftOdom (state_R l) [1, 0] (encOdom l) r + +@[simp] def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomL .leftOdom 1 [1, 0] (encOdom l) r + +def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w + +def init_w0 : zB := (0 : Fin 2) >> 1 >> 0 >> 1 >> default + +lemma step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append, z00]; execute + +lemma step_R_0 (l : List OdomTok) (r : zB) : + (cfg_R l ((0 : Fin 2) >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + +lemma step_R_100 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 0 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L2 :: l) r := by + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_R_11 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 1 >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + +lemma step_R_1010 (l : List OdomTok) (r : zB) : + (cfg_R l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L0 :: l) r := by + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L0 (l : List OdomTok) (r : zB) : + (cfg_L (.L0 :: l) r) [target_tm]⊢⁺ cfg_R (.L1 :: l) r := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L1 (l : List OdomTok) (r : zB) : + (cfg_L (.L1 :: l) r) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r) := by + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_L2 (l : List OdomTok) (r : zB) : + (cfg_L (.L2 :: l) r) [target_tm]⊢⁺ cfg_L l ((0 : Fin 2) >> 1 >> 0 >> r) := by + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + +lemma step_L_nil (r : zB) : + (cfg_L [] r) [target_tm]⊢⁺ cfg_R [] ((1 : Fin 2) >> 0 >> r) := by + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append, z00]; execute + +@[simp] +def cap : List OdomTok → Nat + | [] => 0 + | .L0 :: l => 2 * cap l + 1 + | .L1 :: l => 2 * cap l + | .L2 :: l => cap l / 3 + +@[simp] +def dec_fuel : Nat → List OdomTok → List OdomTok + | 0, l => l + | _ + 1, [] => [] + | _ + 1, .L0 :: l => .L1 :: l + | n + 1, .L1 :: l => .L0 :: dec_fuel n l + | n + 1, .L2 :: l => .L2 :: dec_fuel n (dec_fuel n (dec_fuel n l)) + +def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l + +@[simp] +lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := by + induction n generalizing l with + | zero => rfl + | succ n ih => + cases l with + | nil => rfl + | cons t tl => cases t <;> simp [dec_fuel, ih] + +@[simp] +lemma length_dec (l : List OdomTok) : (dec l).length = l.length := + length_dec_fuel l.length l + +@[simp] lemma dec_nil : dec [] = [] := rfl +@[simp] lemma dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl +@[simp] lemma dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl +@[simp] lemma dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by + simp only [dec, List.length_cons, dec_fuel, length_dec_fuel] + +lemma cap_dec_aux (n : Nat) : + ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → cap (dec l) = cap l - 1 := by + induction n with + | zero => + intro l hlen h + cases l <;> simp at hlen h + | succ n ih => + intro l hlen h + cases l with + | nil => simp at h + | cons t l => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => simp + | L1 => + simp only [cap, dec_L1] at h ⊢ + have h1 : cap l ≥ 1 := by omega + rw [ih l hlen h1]; omega + | L2 => + simp only [cap, dec_L2] at h ⊢ + have h1 : cap l ≥ 3 := by omega + have ih1 := ih l hlen (by omega) + have hlen1 : (dec l).length ≤ n := by rw [length_dec]; exact hlen + have ih2 := ih (dec l) hlen1 (by omega) + have hlen2 : (dec (dec l)).length ≤ n := by rw [length_dec, length_dec]; exact hlen + have ih3 := ih (dec (dec l)) hlen2 (by omega) + rw [ih3, ih2, ih1]; omega + +lemma cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := + cap_dec_aux l.length l (Nat.le_refl _) h + +lemma runHL_dec_aux (n : Nat) : + ∀ (l : List OdomTok) (r : zB), l.length ≤ n → cap l ≥ 1 → + (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := by + induction n with + | zero => + intro l _ hlen h + cases l <;> simp at hlen h + | succ n ih => + intro l r hlen h + cases l with + | nil => simp at h + | cons t l => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => + simp only [dec_L0] + exact step_L_L0 l r + | L1 => + simp only [cap, dec_L1] at h ⊢ + have h1 : cap l ≥ 1 := by omega + exact zPpp (step_L_L1 l r) + (zPpp (ih l _ hlen h1) (step_R_1010 (dec l) r)) + | L2 => + simp only [cap, dec_L2] at h ⊢ + have hc3 : cap l ≥ 3 := by omega + have hdec1 : cap (dec l) = cap l - 1 := cap_dec l (by omega) + have hdec2 : cap (dec (dec l)) = cap l - 2 := by + rw [cap_dec (dec l) (by omega), hdec1]; omega + have hlen1 : (dec l).length ≤ n := by rw [length_dec]; exact hlen + have hlen2 : (dec (dec l)).length ≤ n := by rw [length_dec]; exact hlen1 + exact zPpp (step_L_L2 l r) + (zPpp (ih l _ hlen (by omega)) + (zPpp (step_R_0 (dec l) _) + (zPpp (ih (dec l) _ hlen1 (by omega)) + (zPpp (step_R_11 (dec (dec l)) _) + (zPpp (ih (dec (dec l)) _ hlen2 (by omega)) + (step_R_100 (dec (dec (dec l))) r)))))) + +lemma runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : + (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := + runHL_dec_aux l.length l r (Nat.le_refl _) h + +@[simp] +def mod3Bits (c : Nat) : List (Fin 2) := + if c % 3 = 0 then [0, 1, 0] + else if c % 3 = 1 then [1, 1, 0] + else [1, 0, 0] + +@[simp] +def drain : List OdomTok → List (Fin 2) + | [] => [1, 0] + | .L0 :: tl => drain tl ++ [1, 0, 1, 0] + | .L1 :: tl => drain tl ++ [1, 0, 1, 0] + | .L2 :: tl => drain tl ++ mod3Bits (cap tl) + +lemma drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] + | [] => by decide + | .L0 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + | .L1 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + | .L2 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ + +lemma drain_dec_aux (n : Nat) : + ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → drain (dec l) = drain l := by + induction n with + | zero => + intro l hlen hcap + cases l <;> simp at hlen hcap + | succ n ih => + intro l hlen hcap + cases l with + | nil => simp at hcap + | cons t tl => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => rfl + | L1 => + simp only [cap, dec_L1, drain] at hcap ⊢ + rw [ih tl hlen (by omega)] + | L2 => + simp only [cap, dec_L2, drain] at hcap ⊢ + have hc3 : cap tl ≥ 3 := by omega + have hdec1' : cap (dec tl) = cap tl - 1 := cap_dec tl (by omega) + have hdec2 : cap (dec (dec tl)) = cap tl - 2 := by + rw [cap_dec (dec tl) (by omega), hdec1']; omega + have hdec3 : cap (dec (dec (dec tl))) = cap tl - 3 := by + rw [cap_dec (dec (dec tl)) (by omega), hdec2]; omega + have hlen1 : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have hlen2 : (dec (dec tl)).length ≤ n := by rw [length_dec]; exact hlen1 + have ih1 := ih tl hlen (by omega) + have ih2 := ih (dec tl) hlen1 (by omega) + have ih3 := ih (dec (dec tl)) hlen2 (by omega) + have hmod : mod3Bits (cap (dec (dec (dec tl)))) = mod3Bits (cap tl) := by + simp only [mod3Bits, hdec3] + have hrem : (cap tl - 3) % 3 = cap tl % 3 := by omega + rw [hrem] + rw [ih3, ih2, ih1, hmod] + +lemma drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := + drain_dec_aux l.length l (Nat.le_refl _) hcap + +lemma append_list_assoc (xs ys : List (Fin 2)) (w : zB) : + (xs ++ ys) +> w = xs +> (ys +> w) := by + induction xs with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +lemma run_drain_aux (n : Nat) : + ∀ (l : List OdomTok) (w : zB), l.length ≤ n → cap l = 0 → + (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := by + induction n with + | zero => + intro l w hlen _ + cases l with + | nil => exact step_L_nil w + | cons _ _ => simp at hlen + | succ n ih => + intro l w hlen hcap + cases l with + | nil => exact step_L_nil w + | cons t tl => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlen + cases t with + | L0 => simp only [cap] at hcap; omega + | L1 => + simp only [cap] at hcap + have htl : cap tl = 0 := by omega + simp only [drain, append_list_assoc] + exact zPpp (step_L_L1 tl w) (ih tl ([1, 0, 1, 0] +> w) hlen htl) + | L2 => + simp only [cap] at hcap + simp only [drain, append_list_assoc] + have hcases : cap tl = 0 ∨ cap tl = 1 ∨ cap tl = 2 := by omega + rcases hcases with h0 | h1 | h2 + · have hm : mod3Bits (cap tl) = [0, 1, 0] := by simp [mod3Bits, h0] + rw [hm] + exact zPpp (step_L_L2 tl w) (ih tl ([0, 1, 0] +> w) hlen h0) + · have hm : mod3Bits (cap tl) = [1, 1, 0] := by simp [mod3Bits, h1] + rw [hm] + have hdec1_cap : cap (dec tl) = 0 := by have := cap_dec tl (by omega); omega + have hdec1_len : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have h_ih := ih (dec tl) ([1, 1, 0] +> w) hdec1_len hdec1_cap + rw [drain_dec tl (by omega)] at h_ih + exact zPpp (step_L_L2 tl w) + (zPpp (runHL_dec tl ((0 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_0 (dec tl) ((1 : Fin 2) >> 0 >> w)) h_ih)) + · have hm : mod3Bits (cap tl) = [1, 0, 0] := by simp [mod3Bits, h2] + rw [hm] + have hdec1_cap : cap (dec tl) = 1 := by have := cap_dec tl (by omega); omega + have hdec2_cap : cap (dec (dec tl)) = 0 := by + have := cap_dec (dec tl) (by omega); omega + have hdec1_len : (dec tl).length ≤ n := by rw [length_dec]; exact hlen + have hdec2_len : (dec (dec tl)).length ≤ n := by rw [length_dec]; exact hdec1_len + have h_ih := ih (dec (dec tl)) ([1, 0, 0] +> w) hdec2_len hdec2_cap + rw [drain_dec (dec tl) (by omega), drain_dec tl (by omega)] at h_ih + exact zPpp (step_L_L2 tl w) + (zPpp (runHL_dec tl ((0 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_0 (dec tl) ((1 : Fin 2) >> 0 >> w)) + (zPpp (runHL_dec (dec tl) ((1 : Fin 2) >> 1 >> 0 >> w) (by omega)) + (zPpp (step_R_11 (dec (dec tl)) ((0 : Fin 2) >> w)) h_ih)))) + +lemma run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : + (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := + run_drain_aux l.length l w (Nat.le_refl _) hcap + +def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := + if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) + +lemma stepL_state_sound (l : List OdomTok) (w : zB) : + (cfg_L l w) [target_tm]⊢⁺ cfg_R (stepL_state l w).1 (stepL_state l w).2 := by + unfold stepL_state + split_ifs with hcap + · exact runHL_dec l w hcap + · have hz : cap l = 0 := by omega + exact run_drain l w hz + +lemma step_R_partition (l : List OdomTok) (w : zB) + (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : + (∃ t w', (cfg_R l w) [target_tm]⊢⁺ cfg_R (t :: l) w') ∨ + (∃ w', (cfg_R l w) [target_tm]⊢⁺ cfg_L l w') ∨ + (∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) := by + rcases fin2_cases w.head with h0 | h1 + · have hw0 : w = (0 : Fin 2) >> w.tail := by + conv_lhs => rw [← ListBlank.cons_head_tail w, h0] + rw [hw0] + exact Or.inr (Or.inl ⟨(1 : Fin 2) >> w.tail, step_R_0 l w.tail⟩) + · rcases fin2_cases w.tail.head with h10 | h11 + · rcases fin2_cases w.tail.tail.head with h100 | h101 + · have hw : w = (1 : Fin 2) >> 0 >> 0 >> w.tail.tail.tail := by + conv_lhs => + rw [← ListBlank.cons_head_tail w, h1, + ← ListBlank.cons_head_tail w.tail, h10, + ← ListBlank.cons_head_tail w.tail.tail, h100] + rw [hw] + exact Or.inl ⟨.L2, w.tail.tail.tail, step_R_100 l w.tail.tail.tail⟩ + · rcases fin2_cases w.tail.tail.tail.head with h1010 | h1011 + · have hw : w = (1 : Fin 2) >> 0 >> 1 >> 0 >> w.tail.tail.tail.tail := by + conv_lhs => + rw [← ListBlank.cons_head_tail w, h1, + ← ListBlank.cons_head_tail w.tail, h10, + ← ListBlank.cons_head_tail w.tail.tail, h101, + ← ListBlank.cons_head_tail w.tail.tail.tail, h1010] + rw [hw] + exact Or.inl ⟨.L0, w.tail.tail.tail.tail, step_R_1010 l w.tail.tail.tail.tail⟩ + · rcases hguard with hg0 | ⟨_, hg2 | hg3⟩ + · rw [h1] at hg0; nomatch hg0 + · rw [h101] at hg2; nomatch hg2 + · rw [h1011] at hg3; nomatch hg3 + · rcases hguard with hg0 | ⟨hg1, _⟩ + · rw [h1] at hg0; nomatch hg0 + · rw [h11] at hg1; nomatch hg1 + +lemma step_R_closed (l : List OdomTok) (w : zB) + (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : + ∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ + (IsInOdomSystem cfg' ∨ (step target_tm cfg').isNone) := by + rcases step_R_partition l w hguard with ⟨t, w', hpush⟩ | ⟨w', hrefl⟩ | ⟨cfg_halt, hhalt, hnone⟩ + · exact ⟨cfg_R (t :: l) w', hpush, Or.inl ⟨t :: l, w', rfl⟩⟩ + · exact ⟨cfg_R (stepL_state l w').1 (stepL_state l w').2, + zPpp hrefl (stepL_state_sound l w'), + Or.inl ⟨(stepL_state l w').1, (stepL_state l w').2, rfl⟩⟩ + · exact ⟨cfg_halt, hhalt, Or.inr hnone⟩ + +lemma step_init_nontrivial : (init []) [target_tm]⊢⁺ cfg_R [.L0, .L0] default := by + have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl + rw [h_init]; simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by + refine ⟨OdomTok, .leftOdom, state_R, 1, [1, 0], [1, 0], [1], odomWord, encOdom, cap, dec, + (fun _ => []), drain, IsInOdomSystem, ?_, ?_, ?_, rfl, ?_, encOdom_non_surjective, rfl, ?_, + length_dec, cap_dec, runHL_dec, (fun stk _ => drain_ne_nil stk), run_drain, + step_R_0, step_R_partition, (fun _ => Iff.rfl), + ⟨[.L0, .L0], default, step_init_nontrivial, by decide, by decide⟩, step_R_closed⟩ + · refine ⟨[.L0, .L1, .L2], by decide, by decide, ?_⟩ + intro t; cases t <;> decide + · decide + · intro t; cases t <;> decide + · intro t stk; rfl + · refine ⟨.L0, .L1, .L2, 3, [1, 0, 1, 0], [1, 0, 0], + by decide, by decide, by decide, (fun _ => rfl), (fun _ => rfl), (fun _ => rfl), + step_R_1010, step_R_100⟩ + +end BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA diff --git a/BusyBeaver/BB6/Accelerations/README.md b/BusyBeaver/BB6/Accelerations/README.md index 42268d7f..2264395b 100644 --- a/BusyBeaver/BB6/Accelerations/README.md +++ b/BusyBeaver/BB6/Accelerations/README.md @@ -1,9 +1,10 @@ # `BB(6)` Stacked, Odometer, and Transducer Accelerations (`BusyBeaver/BB6/Accelerations/`) -This directory contains formal Lean 4 specifications and kernel-verified reductions for 35 `BB(6)` (6-state, 2-symbol) holdout Turing machines whose blank-tape dynamics evolve over unbounded digit stacks, mixed-radix odometers, or bidirectional finite-state word transducers rather than fixed-dimension counter tuples: +This directory contains formal Lean 4 specifications and kernel-verified reductions for 56 `BB(6)` (6-state, 2-symbol) holdout Turing machines whose blank-tape dynamics evolve over unbounded digit stacks, mixed-radix odometers, or bidirectional finite-state word transducers rather than fixed-dimension counter tuples: 1. **15 Structural Stack, Odometer, and Transducer Reductions** formalized under the three structural reduction predicates defined in [`BusyBeaver/Defs.lean`](../../Defs.lean)—`HasStackReduction` (12 machines: 9 `bbchallenge` Wiki machines and 3 Halving Tower holdouts), `HasOdometerReduction` (2 machines: Beaver Math Olympiad Problems 10 and 11), and `HasTransducerReduction` (1 machine: *Bell eats counter*). 2. **20 Open `BB(6)` Acceleration Problems** certified via `IsValidAcceleration` and `IsHalt target ↔ CollatzHalts next start` (with [`1RB1LD_0RC0LF_1LD1RE_0LA0RB_0RD1RB_0LD---`](./M_1RB1LD_0RC0LF_1LD1RE_0LA0RB_0RD1RB_0LDHHH.lean) additionally proved under `HasOdometerReduction`). Each open problem states a self-contained initial state $s_0$ (`start`) and accelerated transition map $T$ (`next`) over finite sequences and non-negative integers: the corresponding Turing machine halts from the blank tape if and only if iterating $T$ from $s_0$ eventually reaches $\mathrm{Halt}$ (`none`). For **13** of the 20 machines, we additionally prove a **higher-level Poincaré / epoch acceleration** $(s_{0,\mathrm{HL}}, T_{\mathrm{HL}})$ (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) that eliminates an entire stack, mixed-radix odometer, or auxiliary mode by restricting to a canonical return section or contracting full multi-bounce epochs. +3. **21 Hard Holdout Cryptid Machines** formalized under `IsSegmentedCryptid` (10 machines), `IsStackCryptid` (9 machines), and `IsOdometerCryptid` (2 machines), capturing the full remaining frontier of BB(6) hard holdouts. > **Hardness & Formal Evidence.** The Collatz-like stacked cryptids among these machines (`#391`, `#129`, `#660`/`#659`/`#209`/`#680`/`#480`, `#549`/`#80`, `#33`, `#85`/`#285`/`#490`/`#500`) are classified, with heuristic hazards and the resolved case `#72`, in [`../Hardness.lean`](../Hardness.lean) (`BusyBeaver.BB6.Hardness`), and kernel-checked live-hazard witnesses and halting residue classes for the accelerated problems are proved in [`../HardnessEvidence.lean`](../HardnessEvidence.lean) (`BusyBeaver.BB6.HardnessEvidence`). @@ -827,3 +828,31 @@ T(M_0(L, R)) = \begin{cases} $$ where $\mathcal{D}$ (`stepD`) peels $[(0, 1), (0, 1)]$ pairs on $L$ and, on $[(0, 1), (1, 4)] \cdot L_2$ with $L_2 \ne \varepsilon$, invokes the 6-state carry transducer `evalStage3` over $\mathcal{F} = \lbrace f_{00}, \dots, f_{05} \rbrace$ (halting at `stepD` or `evalQ0Aux` on any head block $[(a, s)] \cdot X$ with $a \ge 2$, and at `stepBit1` on carry state $f_{05}$); see [`M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA.lean`](./M_1RBHHH_1LC0RF_0RA0LD_1LE1LA_1RF0LF_0LC0RA.lean) for full definitions. + +## 4. Hard Holdout Cryptid Machines (21 Machines) + +The remaining frontier of hard holdout Turing machines in BB(6) whose blank-tape trajectories enter closed dynamic schemas over partitioned half-tapes (`IsSegmentedCryptid`), multi-layer stack systems (`IsStackCryptid`), or mixed-radix odometer bitstreams (`IsOdometerCryptid`): + +| Machine (`bbchallenge` RLE) | Predicate | Lean 4 Proof | +| :--- | :--- | :--- | +| `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` | `IsSegmentedCryptid` | [`M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean`](./M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean) | +| `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` | `IsSegmentedCryptid` | [`M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean`](./M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean) | +| `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` | `IsOdometerCryptid` | [`M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean`](./M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean) | +| `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` | `IsStackCryptid` | [`M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean`](./M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean) | +| `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` | `IsSegmentedCryptid` | [`M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean`](./M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean) | +| `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` | `IsStackCryptid` | [`M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean`](./M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean) | +| `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` | `IsSegmentedCryptid` | [`M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean`](./M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean) | +| `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` | `IsSegmentedCryptid` | [`M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean`](./M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean) | +| `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` | `IsSegmentedCryptid` | [`M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean`](./M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean) | +| `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` | `IsSegmentedCryptid` | [`M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean`](./M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean) | +| `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` | `IsSegmentedCryptid` | [`M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean`](./M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean) | +| `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` | `IsSegmentedCryptid` | [`M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean`](./M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean) | +| `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` | `IsSegmentedCryptid` | [`M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean`](./M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean) | +| `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` | `IsSegmentedCryptid` | [`M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean`](./M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean) | +| `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` | `IsOdometerCryptid` | [`M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean`](./M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean) | diff --git a/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean b/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean new file mode 100644 index 00000000..f0dcacbc --- /dev/null +++ b/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean @@ -0,0 +1,1566 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Bridge + +/-! +# Busy Beaver Machine `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` — `is_cryptid` (`IsCryptid target_tm`) + +This file imports shared trusted definitions from `BusyBeaver.Basic` +and defines `target_tm` for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. Do not modify the trusted +definitions section or the goal theorem signature. +-/ + +@[expose] public section + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE + +-- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +/-- Transition function for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 1 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 1, Stmt.write 0 Dir.left) + | 2, 0 => some (some 3, Stmt.write 1 Dir.right) + | 2, 1 => some (some 2, Stmt.write 1 Dir.left) + | 3, 0 => some (some 3, Stmt.write 1 Dir.right) + | 3, 1 => some (some 0, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 0 Dir.left) + | 5, 0 => none + | 5, 1 => some (some 4, Stmt.write 1 Dir.right) + +-- END TRUSTED DEFINITIONS + + +-- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS + +namespace Solution + +set_option linter.unusedVariables false +set_option linter.unusedSimpArgs false +set_option linter.deprecated false +set_option linter.dupNamespace false +set_option linter.unreachableTactic false +set_option linter.unusedTactic false +set_option quotPrecheck false +set_option maxRecDepth 4000000 +set_option maxHeartbeats 8000000 + +variable {zG_ zL_ α β γ : Type*} [Inhabited zG_] [Inhabited zL_] +abbrev A : Fin 6 := 0 +abbrev B : Fin 6 := 1 +abbrev C : Fin 6 := 2 +abbrev D : Fin 6 := 3 +abbrev E : Fin 6 := 4 +abbrev F : Fin 6 := 5 +variable {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] +set_option linter.unusedSimpArgs false +set_option maxHeartbeats 8000000 +set_option maxRecDepth 4000000 +namespace Solution +@[simp] lemma zPz (l : List (Fin 2)) : l ^ (0 : Nat) = [] := rfl +@[simp] lemma zPsl (l : List (Fin 2)) (n : Nat) : l ^ (n + 1) = l ++ (l ^ n) := rfl +@[simp] lemma zCal (x : α) (l₁ l₂ : List α) : (x :: l₁) ++ l₂ = x :: (l₁ ++ l₂) := rfl +@[simp] lemma zLan (b : ListBlank (Fin 2)) : ([] : List (Fin 2)) +> b = b := rfl +@[simp] lemma zLac (x : Fin 2) (xs : List (Fin 2)) (b : ListBlank (Fin 2)) : (x :: xs) +> b = x >> (xs +> b) := rfl +@[simp] lemma zZcd : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl +@[simp] lemma zDh : (default : ListBlank (Fin 2)).head = 0 := rfl +@[simp] lemma zDt : (default : ListBlank (Fin 2)).tail = default := rfl +lemma zStp {c_1 c_2 : Cfg (Fin 2) (Fin 6)} (h : step target_tm c_1 = some c_2) : c_1 [target_tm]⊢⁺ c_2 := ⟨1, by decide, h⟩ +local notation "zzTP" => TapePattern (Fin 2) (Fin 6) +local notation "zzTE" => TapeExpr (Fin 2) +local notation "zzG" => Cfg (Fin 2) (Fin 6) +local notation "zzV" => Nat -> Nat +local notation "zzE" => evalTapePattern +local notation "zzD" => TapeExpr.default +local notation "zz0" x:arg => TapeExpr.sym 0 x +local notation "zz1" x:arg => TapeExpr.sym 1 x +local notation "zzR" l:arg v:arg x:arg => TapeExpr.rep l v x +local notation "zzM" l:arg q:arg r:arg => ({ left := l, head := some q, right := r } : TapePattern (Fin 2) (Fin 6)) +local notation "zzF1" a:arg => (fun k : Nat => match k with | 0 => a | _ => 0) +local notation "zzF2" a:arg b:arg => (fun k : Nat => match k with | 0 => a | 1 => b | _ => 0) +local notation "zzF3" a:arg b:arg c:arg => (fun k : Nat => match k with | 0 => a | 1 => b | 2 => c | _ => 0) +local notation "zzF4" a:arg b:arg c:arg d:arg => (fun k : Nat => match k with | 0 => a | 1 => b | 2 => c | 3 => d | _ => 0) +local macro "zzS1" : tactic => `(tactic| simp only [step, target_tm, evalTapePattern, evalTapeExpr, zPz, zPsl, zCal, List.singleton_append, List.nil_append, Turing.Tape.write, Turing.Tape.move, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt, Option.map]) +local macro "zzS2" : tactic => `(tactic| simp only [zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt]) +local macro "zzD1" a:ident b:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; zzS1)) +local macro "zzD2" a:ident b:ident c:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; rw [$c:ident]; zzS1)) +local macro "zzD3" a:ident b:ident c:ident : tactic => `(tactic| (rw [$c:ident]; simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; zzS1)) +local macro "zzD4" a:ident b:ident c:ident d:ident : tactic => `(tactic| (rw [$c:ident]; simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; rw [$d:ident]; zzS1)) +local macro "zzD5" a:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, evalTapeExpr]; zzS1)) +local macro "zzH" v:ident h:ident e:term : tactic => `(tactic| obtain ⟨$v:ident, $h:ident⟩ : ∃ $v:ident : zzV, $v:ident = $e := ⟨_, rfl⟩) +@[simp] abbrev zP0 := (zzM (zz1 (zz1 zzD)) 0 zzD) +@[simp] def zK1 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 zzD) zv +@[simp] def zK2 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 2 (zz1 zzD)) zv +@[simp] def zK3 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 zzD))) zv +@[simp] def zK4 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK5 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zz1 zzD))))) zv +@[simp] def zK6 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK7 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 zzD))) zv +@[simp] def zK8 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK9 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 zzD))))) zv +@[simp] def zK10 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD))))) zv +@[simp] def zK11 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz1 zzD))) zv +@[simp] def zK12 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD)))))) zv +@[simp] def zK13 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 zzD)) zv +@[simp] def zK14 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD))))) zv +@[simp] def zK15 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 zzD)) zv +@[simp] def zK16 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 zzD))) zv +@[simp] def zK17 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD)))))) zv +@[simp] def zK18 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 zzD))) zv +@[simp] def zK19 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 zzD)) zv +@[simp] def zK20 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 (zz1 zzD))))) zv +@[simp] def zK21 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 zzD)))) zv +@[simp] def zK22 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 zzD)) zv +@[simp] def zK23 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 zzD))) zv +@[simp] def zK24 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 zzD)))))) zv +@[simp] def zK25 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 zzD))) zv +@[simp] def zK26 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 zzD))) zv +@[simp] def zK27 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK28 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK29 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] abbrev zP30 := (zzM zzD 2 (zz0 (zz1 (zzR [0,1] 0 zzD)))) +@[simp] def zK31 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv +@[simp] def zK32 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv +@[simp] def zK33 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 zzD)) zv +@[simp] def zK34 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK35 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK36 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK37 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK38 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv +@[simp] def zK39 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv +@[simp] def zK40 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv +@[simp] def zK41 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv +@[simp] def zK42 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 zzD)) zv +@[simp] def zK43 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK44 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK45 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 zzD)) zv +@[simp] def zK46 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv +@[simp] def zK47 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 zzD)) zv +@[simp] def zK48 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))))) zv +@[simp] def zK49 (zv : zzV) := zzE (zzM zzD 1 (zz1 zzD)) zv +@[simp] def zK50 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD)))))))) zv +@[simp] def zK51 (zv : zzV) := zzE (zzM zzD 1 zzD) zv +@[simp] def zK52 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv +@[simp] def zK53 (zv : zzV) := zzE (zzM zzD 2 zzD) zv +@[simp] def zK54 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv +@[simp] def zK55 (zv : zzV) := zzE (zzM (zz1 zzD) 3 zzD) zv +@[simp] def zK56 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK57 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv +@[simp] def zK58 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 zzD) zv +@[simp] def zK59 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv +@[simp] def zK60 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv +@[simp] def zK61 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 zzD) zv +@[simp] def zK62 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 zzD)) zv +@[simp] def zK63 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK64 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK65 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv +@[simp] abbrev zP66 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 zzD) +@[simp] def zK67 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 zzD) zv +@[simp] abbrev zP68 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))) +@[simp] def zK69 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zzR [0,1] 1 zzD)))) zv +@[simp] def zK70 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD))))))) zv +@[simp] def zK71 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 zzD) zv +@[simp] def zK72 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 zzD) zv +@[simp] def zK73 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 zzD)) zv +@[simp] def zK74 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK75 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 zzD)) zv +@[simp] def zK76 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK77 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK78 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD)))))))) zv +@[simp] def zK79 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 zzD)) zv +@[simp] def zK80 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 zzD)) zv +@[simp] def zK81 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv +@[simp] def zK82 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 zzD))) zv +@[simp] def zK83 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv +@[simp] def zK84 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK85 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv +@[simp] def zK86 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK87 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK88 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv +@[simp] def zK89 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD)))))))) zv +@[simp] def zK90 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK91 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK92 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))))) zv +@[simp] def zK93 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD))))))))) zv +@[simp] def zK94 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK95 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK96 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK97 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK98 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK99 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK100 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK101 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK102 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK103 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK104 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK105 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv +@[simp] def zK106 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK107 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK108 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] def zK109 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK110 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK111 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK112 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK113 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK114 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK115 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK116 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK117 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK118 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK119 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK120 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK121 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK122 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK123 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK124 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK125 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK126 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv +@[simp] def zK127 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 zzD))))) zv +@[simp] def zK128 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] def zK129 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] def zK130 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))))) zv +@[simp] def zK131 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 zzD)))))) zv +@[simp] def zK132 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))))) zv +@[simp] def zK133 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK134 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK135 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv +@[simp] def zK136 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK137 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK138 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK139 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))) zv +@[simp] abbrev zP140 := (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) +@[simp] def zK141 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK142 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK143 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 zzD))) zv +@[simp] def zK144 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv +@[simp] def zK145 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK146 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK147 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK148 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK149 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 zzD)) zv +@[simp] def zK150 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))) zv +@[simp] def zK151 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK152 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK153 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK154 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK155 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK156 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK157 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 zzD) zv +@[simp] def zK158 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 zzD))) zv +@[simp] def zK159 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv +@[simp] def zK160 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK161 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK162 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK163 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK164 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK165 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK166 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK167 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 zzD) zv +@[simp] def zK168 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 zzD)) zv +@[simp] def zK169 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD))))) zv +@[simp] def zK170 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK171 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK172 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK173 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 zzD)) zv +@[simp] def zK174 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK175 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK176 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK177 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK178 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK179 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK180 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv +@[simp] def zK181 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 zzD)) zv +@[simp] def zK182 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 zzD)) zv +@[simp] def zK183 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 zzD) zv +@[simp] def zK184 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 zzD))) zv +@[simp] def zK185 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD)))))) zv +@[simp] def zK186 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK187 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv +@[simp] def zK188 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK189 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 zzD))) zv +@[simp] def zK190 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 zzD))) zv +@[simp] def zK191 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK192 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK193 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK194 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK195 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK196 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK197 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK198 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))) zv +@[simp] def zK199 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 zzD))) zv +@[simp] def zK200 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 zzD))) zv +@[simp] def zK201 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK202 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK203 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK204 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK205 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 zzD)))) zv +@[simp] def zK206 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK207 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] abbrev zP208 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) +@[simp] def zK209 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 zzD)))) zv +@[simp] def zK210 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK211 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zz1 zzD)))) zv +@[simp] def zK212 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv +@[simp] def zK213 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv +@[simp] def zK214 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv +@[simp] def zK215 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK216 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] def zK217 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK218 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 zzD))))) zv +@[simp] def zK219 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK220 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK221 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK222 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 zzD))) zv +@[simp] def zK223 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK224 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK225 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 zzD)) zv +@[simp] def zK226 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK227 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK228 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK229 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK230 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK231 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK232 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK233 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 zzD)))))) zv +@[simp] def zK234 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK235 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK236 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv +@[simp] def zK237 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 zzD)) zv +@[simp] def zK238 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK239 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK240 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK241 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 zzD) zv +@[simp] def zK242 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv +@[simp] def zK243 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv +@[simp] def zK244 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv +@[simp] abbrev zP245 := (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 (zzR [1,1] 0 zzD)))) +@[simp] def zK246 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK247 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK248 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK249 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv +@[simp] def zK250 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD)))))) zv +@[simp] def zK251 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK252 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK253 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK254 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK255 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))))) zv +@[simp] def zK256 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))))) zv +@[simp] def zK257 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK258 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 zzD)) zv +@[simp] def zK259 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv +@[simp] def zK260 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK261 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK262 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK263 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))))) zv +@[simp] def zK264 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD))))))) zv +@[simp] def zK265 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv +@[simp] def zK266 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK267 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK268 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 zzD) zv +@[simp] def zK269 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 zzD)))) zv +@[simp] def zK270 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] abbrev zP271 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zzR [1,1] 1 zzD)))) +@[simp] def zK272 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK273 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 zzD)) zv +@[simp] def zK274 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv +@[simp] def zK275 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK276 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK277 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK278 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK279 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK280 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK281 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK282 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK283 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK284 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK285 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK286 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK287 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK288 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK289 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK290 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK291 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv +@[simp] def zK292 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK293 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK294 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv +@[simp] def zK295 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv +@[simp] def zK296 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))))) zv +@[simp] def zK297 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK298 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK299 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK300 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK301 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK302 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK303 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK304 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK305 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv +@[simp] def zK306 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK307 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK308 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK309 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 zzD)) zv +@[simp] def zK310 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK311 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK312 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK313 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv +@[simp] def zK314 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK315 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK316 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK317 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 zzD))) zv +@[simp] def zK318 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK319 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK320 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] abbrev zP321 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) +@[simp] def zK322 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK323 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))) zv +@[simp] def zK324 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK325 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK326 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK327 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK328 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK329 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK330 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK331 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK332 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK333 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv +@[simp] def zK334 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv +@[simp] def zK335 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv +@[simp] def zK336 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK337 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv +@[simp] def zK338 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK339 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK340 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv +@[simp] def zK341 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK342 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] def zK343 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK344 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK345 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK346 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK347 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK348 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK349 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK350 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv +@[simp] def zK351 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv +@[simp] def zK352 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK353 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv +@[simp] def zK354 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv +@[simp] def zK355 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))))) zv +@[simp] def zK356 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))))) zv +@[simp] def zK357 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv +@[simp] def zK358 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv +@[simp] def zK359 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv +@[simp] def zK360 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv +@[simp] def zK361 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv +@[simp] def zK362 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv +@[simp] abbrev p_271_step1 := (zzM (zz1 (zzR [1,1] 0 zzD)) 0 (zz1 (zz0 (zz1 (zzR [1,1] 1 zzD))))) +@[simp] abbrev pat_30_step1 := (zzM (zz1 zzD) 3 (zz1 (zzR [0,1] 0 zzD))) +@[simp] abbrev pat_140_step1 := (zzM (zz1 zzD) 3 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) +@[simp] abbrev pat_A3 := (zzM (zz1 (zzR [1] 0 (zzR [1,1] 1 zzD))) 3 (zzR [0] 2 (zzR [0,0] 3 (zzR [1] 4 (zzR [0,1] 5 (zzR [1,1] 6 zzD)))))) +def zC30 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 1 1)) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.not (.ge_const 6 1))))))) +def zC140 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 1 1)) (.and (.and (.ge_const 2 1) (.not (.ge_const 2 2))) (.and (.and (.ge_const 4 3) (.not (.ge_const 4 4))) (.not (.ge_const 5 1)))))) +def zC66 : VarCond := (.and (.and (.ge_const 0 1) (.not (.ge_const 0 2))) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.not (.ge_const 4 1)) (.and (.not (.ge_const 5 1)) (.not (.ge_const 6 1))))))) +def zC76 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.ge_const 1 1) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.and (.ge_const 5 1) (.not (.ge_const 6 1)))))))) +def zC331 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.and (.ge_const 5 1) (.ge_const 6 1)))))) +def cond_A3 : VarCond := (.or zC30 (.or zC140 (.or zC66 (.or zC76 zC331)))) +def ps : TapePatternSet (Fin 2) (Fin 6) := (pat_A3, cond_A3) :: [] +lemma mem_ps_A3 : (pat_A3, cond_A3) ∈ ps := .head _ +lemma in_ps_30_step1 (zv : zzV) : IsInPatternSet ps (zzE pat_30_step1 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 | 6 => 0 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [pat_30_step1, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC30 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC30, evalVarCond]; try omega + exact Or.inl h_c +lemma in_ps_140_step1 (zv : zzV) : IsInPatternSet ps (zzE pat_140_step1 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 1 | 3 => zv 0 | 4 => 3 | 5 => 0 | 6 => zv 1 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [pat_140_step1, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC140 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 1 | 3 => zv 0 | 4 => 3 | 5 => 0 | 6 => zv 1 | _ => 0) := by simp -failIfUnchanged [zC140, evalVarCond]; try omega + exact Or.inr (Or.inl h_c) +lemma zI66 (zv : zzV) : IsInPatternSet ps (zzE zP66 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 1 | 1 => zv 0 | 2 => 0 | 3 => 0 | 4 => 0 | 5 => 0 | 6 => 0 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zP66, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC66 (fun k => match k with | 0 => 1 | 1 => zv 0 | 2 => 0 | 3 => 0 | 4 => 0 | 5 => 0 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC66, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inl h_c)) +lemma zI63 (zv : zzV) : IsInPatternSet ps (zK63 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => 0 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zK63, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC76 (fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC76, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inr (Or.inl h_c))) +lemma zI76 (zv : zzV) : IsInPatternSet ps (zK76 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => 0 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zK76, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC76 (fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC76, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inr (Or.inl h_c))) +lemma zI287 (zv : zzV) : IsInPatternSet ps (zK287 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zK287, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) +lemma zI314 (zv : zzV) : IsInPatternSet ps (zK314 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zK314, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) +lemma zI331 (zv : zzV) : IsInPatternSet ps (zK331 zv) := by + refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => zv 2 + 1 | _ => 0, ?_, ?_⟩ + · simp -failIfUnchanged only [zK331, pat_A3, evalTapePattern, evalTapeExpr] + zzS2 + · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => zv 2 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega + exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) +lemma init_reaches_pat_30_step1 : (init []) [target_tm]⊢* (zzE pat_30_step1 (fun _ => 0)) := by + use 4 + have h_raw : multiStep target_tm (init []) 4 = some (⟨some 3, ⟨1, (1 : Fin 2) >> default, (0 : Fin 2) >> default⟩⟩ : Cfg (Fin 2) (Fin 6)) := rfl + rw [h_raw] + simp only [pat_30_step1, evalTapePattern, evalTapeExpr, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] +@[simp] lemma zMz (M : Machine zG_ zL_) (config : Cfg zG_ zL_) : multiStep M config 0 = some config := rfl +@[simp] lemma zMo (M : Machine zG_ zL_) (config : Cfg zG_ zL_) : multiStep M config 1 = step M config := rfl +@[simp] lemma zMs (M : Machine zG_ zL_) (config : Cfg zG_ zL_) (n : Nat) : + multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by + rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] +lemma zMa {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] + (tm : Machine zG_ zL_) (c_1 : Cfg zG_ zL_) (n m : Nat) : + multiStep tm c_1 (n + m) = (multiStep tm c_1 n).bind (fun c_2 => multiStep tm c_2 m) := by + induction m with + | zero => simp + | succ m' ih => + rw [Nat.add_succ, zMs, ih, Option.bind_assoc] + simp_rw [zMs] +lemma zMt {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] + (tm : Machine zG_ zL_) (c_1 c_2 c_3 : Cfg zG_ zL_) (n m : Nat) + (h₁ : c_1 [tm]⊢^{n} c_2) (h₂ : c_2 [tm]⊢^{m} c_3) : + c_1 [tm]⊢^{n+m} c_3 := by + rw [zMa, h₁]; simp [h₂] +lemma zPt {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] + {tm : Machine zG_ zL_} {c_1 c_2 c_3 : Cfg zG_ zL_} + (h₁ : c_1 [tm]⊢⁺ c_2) (h₂ : c_2 [tm]⊢⁺ c_3) : c_1 [tm]⊢⁺ c_3 := by + obtain ⟨n, n_pos, hn⟩ := h₁ + obtain ⟨m, _, hm⟩ := h₂ + exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c_1 c_2 c_3 n m hn hm⟩ +local notation "zzQ" c:arg => ∃ cfg', (c [target_tm]⊢⁺ cfg') /\ (IsInPatternSet ps cfg' \/ (step target_tm cfg').isNone) +lemma zzB {c_1 c_2 : Cfg (Fin 2) (Fin 6)} + (h_step : step target_tm c_1 = some c_2) + (h_in : IsInPatternSet ps c_2) : + zzQ (c_1) := + ⟨c_2, zStp h_step, Or.inl h_in⟩ +lemma zzC {c_1 c_2 : Cfg (Fin 2) (Fin 6)} + (h_step : step target_tm c_1 = some c_2) + (h_next : zzQ (c_2)) : + zzQ (c_1) := by + rcases h_next with ⟨cfg', h₂, h_in⟩ + exact ⟨cfg', zPt (zStp h_step) h₂, h_in⟩ +local macro "zzR1" p1:ident p2:ident v:ident h:ident : tactic => `(tactic| refine @zzC _ (zzE $p2:ident $v:ident) (by zzD3 $p1:ident $p2:ident $h:ident) ?_) +local macro "zzR2" p1:ident p2:ident v:ident h:ident hr:ident : tactic => `(tactic| refine @zzC _ (zzE $p2:ident $v:ident) (by zzD4 $p1:ident $p2:ident $h:ident $hr:ident) ?_) +local macro "zzO" v:ident h:ident e:term p1:ident p2:ident : tactic => `(tactic| (zzH $v:ident $h:ident $e; zzR1 $p1:ident $p2:ident $v:ident $h:ident)) +local macro "zzO2" v:ident h:ident e:term p1:ident p2:ident hr:ident : tactic => `(tactic| (zzH $v:ident $h:ident $e; zzR2 $p1:ident $p2:ident $v:ident $h:ident $hr:ident)) +local macro "zzK1" c1:ident c2:ident e:term : tactic => `(tactic| (refine zzC ?_ $e; zzD1 $c1:ident $c2:ident)) +local macro "zzK2" c1:ident c2:ident h:ident e:term : tactic => `(tactic| (refine zzC ?_ $e; zzD2 $c1:ident $c2:ident $h:ident)) +local macro "zzKB1" c1:ident c2:ident e:term : tactic => `(tactic| (refine zzB ?_ $e; zzD1 $c1:ident $c2:ident)) +local macro "zzKB2" c1:ident c2:ident h:ident e:term : tactic => `(tactic| (refine zzB ?_ $e; zzD2 $c1:ident $c2:ident $h:ident)) +lemma step_to_ps_30 (zv : zzV) : zzQ ((zzE zP30 zv)) := by zzKB1 zP30 pat_30_step1 (in_ps_30_step1 zv) +lemma step_to_ps_140 (zv : zzV) : zzQ ((zzE zP140 zv)) := by zzKB1 zP140 pat_140_step1 (in_ps_140_step1 zv) +lemma zS27 (zv : zzV) : zzQ ((zK27 zv)) := by zzK1 zK27 zP30 (step_to_ps_30 (zzF1 (1))) +lemma zS25 (zv : zzV) : zzQ ((zK25 zv)) := by zzK1 zK25 zK27 (zS27 (fun _ => 0)) +lemma zS21 (zv : zzV) : zzQ ((zK21 zv)) := by zzK1 zK21 zK25 (zS25 (fun _ => 0)) +lemma zS18 (zv : zzV) : zzQ ((zK18 zv)) := by zzK1 zK18 zK21 (zS21 (fun _ => 0)) +lemma zS15 (zv : zzV) : zzQ ((zK15 zv)) := by zzK1 zK15 zK18 (zS18 (fun _ => 0)) +lemma zS13 (zv : zzV) : zzQ ((zK13 zv)) := by zzK1 zK13 zK15 (zS15 (fun _ => 0)) +lemma zS11 (zv : zzV) : zzQ ((zK11 zv)) := by zzK1 zK11 zK13 (zS13 (fun _ => 0)) +lemma zS44 (zv : zzV) : zzQ ((zK44 zv)) := by zzK1 zK44 zP30 (step_to_ps_30 (zzF1 ((zv 0 + 1)))) +lemma zS39 (zv : zzV) : zzQ ((zK39 zv)) := by zzK1 zK39 zK44 (zS44 (zzF1 (zv 0))) +lemma zS35 (zv : zzV) : zzQ ((zK35 zv)) := by zzK1 zK35 zK39 (zS39 (zzF1 (zv 0))) +lemma zS31 (zv : zzV) : zzQ ((zK31 zv)) := by zzK1 zK31 zK35 (zS35 (zzF1 (1))) +lemma zS28 (zv : zzV) : zzQ ((zK28 zv)) := by zzK1 zK28 zK31 (zS31 (fun _ => 0)) +lemma zS40 (zv : zzV) : zzQ ((zK40 zv)) := by zzK1 zK40 zK35 (zS35 (zzF1 ((zv 0 + 1)))) +lemma zS36 (zv : zzV) : zzQ ((zK36 zv)) := by zzK1 zK36 zK40 (zS40 (zzF1 (zv 0))) +lemma zA41 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK37 zv'))) : + zzQ ((zK41 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK41 zK36 h_vl (zS36 (zzF1 ((zv 1 + 1)))) + · zzK2 zK41 zK37 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) +lemma zS37 (zv : zzV) : zzQ ((zK37 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK37 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK37 zK41 (zA41 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS32 (zv : zzV) : zzQ ((zK32 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK32 zK36 h_vl (zS36 (zzF1 (1))) + · zzK2 zK32 zK37 h_vl (zS37 (zzF2 (l) (1))) +lemma zS29 (zv : zzV) : zzQ ((zK29 zv)) := by zzK1 zK29 zK32 (zS32 (zzF1 (zv 0))) +lemma step_cfg_284_succ (zv : zzV) : zzQ ((zK284 (zzF2 ((zv 0 + 1)) (zv 1)))) := by zzKB1 zK284 zK287 (zI287 (zzF2 (zv 0) (zv 1))) +lemma zS281 (zv : zzV) : zzQ ((zK281 zv)) := by zzK1 zK281 zK284 (step_cfg_284_succ zv) +lemma zS279 (zv : zzV) : zzQ ((zK279 zv)) := by zzK1 zK279 zK281 (zS281 (zzF2 (zv 0) (zv 1))) +lemma zS275 (zv : zzV) : zzQ ((zK275 zv)) := by zzK1 zK275 zK279 (zS279 (zzF2 (zv 0) (zv 1))) +lemma zS270 (zv : zzV) : zzQ ((zK270 zv)) := by zzK1 zK270 zK275 (zS275 (zzF2 (1) (zv 0))) +lemma zS260 (zv : zzV) : zzQ ((zK260 zv)) := by zzK1 zK260 zK270 (zS270 (zzF1 (zv 0))) +lemma zS285 (zv : zzV) : zzQ ((zK285 zv)) := by zzK1 zK285 zK275 (zS275 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS282 (zv : zzV) : zzQ ((zK282 zv)) := by zzK1 zK282 zK285 (zS285 (zzF2 (zv 0) (zv 1))) +lemma zA286 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK283 zv'))) : + zzQ ((zK286 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK286 zK282 h_vl (zS282 (zzF2 ((zv 1 + 1)) (zv 2))) + · zzK2 zK286 zK283 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS283 (zv : zzV) : zzQ ((zK283 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK283 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK283 zK286 (zA286 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS280 (zv : zzV) : zzQ ((zK280 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK280 zK282 h_vl (zS282 (zzF2 (1) (zv 1))) + · zzK2 zK280 zK283 h_vl (zS283 (zzF3 (l) (1) (zv 1))) +lemma zS276 (zv : zzV) : zzQ ((zK276 zv)) := by zzK1 zK276 zK280 (zS280 (zzF2 (zv 0) (zv 1))) +lemma step_hub_271_step1 (zv : zzV) : zzQ ((zzE p_271_step1 zv)) := by + rcases h_vr : zv 1 with _ | r + · rcases h_vl : zv 0 with _ | l + · have h_eq : zzE p_271_step1 zv = zK28 (fun _ => 0) := by + simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK28, evalTapeExpr]; rw [h_vr, h_vl] + zzS2 + rw [h_eq]; exact zS28 (fun _ => 0) + · have h_eq : zzE p_271_step1 zv = zK29 (zzF1 (l)) := by + simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK29, evalTapeExpr]; rw [h_vr, h_vl] + zzS2 + rw [h_eq]; exact zS29 (zzF1 (l)) + · rcases h_vl : zv 0 with _ | l + · have h_eq : zzE p_271_step1 zv = zK260 (zzF1 (r)) := by + simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK260, evalTapeExpr]; rw [h_vr, h_vl] + zzS2 + rw [h_eq]; exact zS260 (zzF1 (r)) + · have h_eq : zzE p_271_step1 zv = zK276 (zzF2 (l) (r)) := by + simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK276, evalTapeExpr]; rw [h_vr, h_vl] + zzS2 + rw [h_eq]; exact zS276 (zzF2 (l) (r)) +lemma step_to_ps_271 (zv : zzV) : zzQ ((zzE zP271 zv)) := by zzK1 zP271 p_271_step1 (step_hub_271_step1 zv) +lemma step_to_ps_245 (zv : zzV) : zzQ ((zzE zP245 zv)) := by zzK1 zP245 p_271_step1 (step_hub_271_step1 (zzF2 (0) (zv 0))) +lemma zS26 (zv : zzV) : zzQ ((zK26 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK26 zK28 h_vl (zS28 (fun _ => 0)) + · zzK2 zK26 zK29 h_vl (zS29 (zzF1 (l))) +lemma zS22 (zv : zzV) : zzQ ((zK22 zv)) := by zzK1 zK22 zK26 (zS26 (zzF1 (zv 0))) +lemma zS19 (zv : zzV) : zzQ ((zK19 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK19 zK15 h_vl (zS15 (fun _ => 0)) + · zzK2 zK19 zK22 h_vl (zS22 (zzF1 (l))) +lemma zS16 (zv : zzV) : zzQ ((zK16 zv)) := by zzK1 zK16 zK19 (zS19 (zzF1 (1))) +lemma zS23 (zv : zzV) : zzQ ((zK23 zv)) := by zzK1 zK23 zK19 (zS19 (zzF1 ((zv 0 + 1)))) +lemma zA24 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK20 zv'))) : + zzQ ((zK24 zv)) := by + zzK1 zK24 zK20 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) +lemma zS20 (zv : zzV) : zzQ ((zK20 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK20 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK20 zK23 h_vr (zS23 (zzF1 (zv 0))) + · zzK2 zK20 zK24 h_vr (zA24 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS17 (zv : zzV) : zzQ ((zK17 zv)) := by zzK1 zK17 zK20 (zS20 (zzF2 (1) (zv 0))) +lemma zS14 (zv : zzV) : zzQ ((zK14 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK14 zK16 h_vr (zS16 (fun _ => 0)) + · zzK2 zK14 zK17 h_vr (zS17 (zzF1 (r))) +lemma zS12 (zv : zzV) : zzQ ((zK12 zv)) := by zzK1 zK12 zK14 (zS14 (zzF1 (zv 0))) +lemma zS10 (zv : zzV) : zzQ ((zK10 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK10 zK11 h_vr (zS11 (fun _ => 0)) + · zzK2 zK10 zK12 h_vr (zS12 (zzF1 (r))) +lemma zS9 (zv : zzV) : zzQ ((zK9 zv)) := by zzK1 zK9 zK10 (zS10 (zzF1 (1))) +lemma zS8 (zv : zzV) : zzQ ((zK8 zv)) := by zzK1 zK8 zK9 (zS9 (fun _ => 0)) +lemma zS7 (zv : zzV) : zzQ ((zK7 zv)) := by zzK1 zK7 zK8 (zS8 (fun _ => 0)) +lemma zS6 (zv : zzV) : zzQ ((zK6 zv)) := by zzK1 zK6 zK7 (zS7 (fun _ => 0)) +lemma zS5 (zv : zzV) : zzQ ((zK5 zv)) := by zzK1 zK5 zK6 (zS6 (fun _ => 0)) +lemma zS4 (zv : zzV) : zzQ ((zK4 zv)) := by zzK1 zK4 zK5 (zS5 (fun _ => 0)) +lemma zS3 (zv : zzV) : zzQ ((zK3 zv)) := by zzK1 zK3 zK4 (zS4 (fun _ => 0)) +lemma zS2 (zv : zzV) : zzQ ((zK2 zv)) := by zzK1 zK2 zK3 (zS3 (fun _ => 0)) +lemma zS1 (zv : zzV) : zzQ ((zK1 zv)) := by zzK1 zK1 zK2 (zS2 (fun _ => 0)) +lemma step_hub_0 (zv : zzV) : zzQ ((zzE zP0 zv)) := by zzK1 zP0 zK1 (zS1 (fun _ => 0)) +lemma zS33 (zv : zzV) : zzQ ((zK33 zv)) := by zzK1 zK33 zP0 (step_hub_0 (fun _ => 0)) +lemma zS61 (zv : zzV) : zzQ ((zK61 zv)) := by zzKB1 zK61 zP66 (zI66 (zzF1 (1))) +lemma zS58 (zv : zzV) : zzQ ((zK58 zv)) := by zzK1 zK58 zK61 (zS61 (fun _ => 0)) +lemma zS55 (zv : zzV) : zzQ ((zK55 zv)) := by zzK1 zK55 zK58 (zS58 (fun _ => 0)) +lemma zS53 (zv : zzV) : zzQ ((zK53 zv)) := by zzK1 zK53 zK55 (zS55 (fun _ => 0)) +lemma zS51 (zv : zzV) : zzQ ((zK51 zv)) := by zzK1 zK51 zK53 (zS53 (fun _ => 0)) +lemma zS49 (zv : zzV) : zzQ ((zK49 zv)) := by zzK1 zK49 zK51 (zS51 (fun _ => 0)) +lemma zS47 (zv : zzV) : zzQ ((zK47 zv)) := by zzK1 zK47 zK49 (zS49 (fun _ => 0)) +lemma zS45 (zv : zzV) : zzQ ((zK45 zv)) := by zzK1 zK45 zK47 (zS47 (fun _ => 0)) +lemma zS42 (zv : zzV) : zzQ ((zK42 zv)) := by zzK1 zK42 zK45 (zS45 (fun _ => 0)) +lemma zS241 (zv : zzV) : zzQ ((zK241 zv)) := by + refine ⟨zzE { left := (.sym 1 (.sym 1 (.sym 1 .default))), head := some 5, right := .default } (fun _ => 0), zStp ?_, Or.inr (by simp [step, target_tm, evalTapePattern, evalTapeExpr])⟩ + zzD5 zK241 +lemma zS225 (zv : zzV) : zzQ ((zK225 zv)) := by zzK1 zK225 zK241 (zS241 (fun _ => 0)) +lemma zS268 (zv : zzV) : zzQ ((zK268 zv)) := by + refine ⟨zzE { left := (.sym 1 (.sym 1 (.sym 1 (.rep [1, 1] 0 .default)))), head := some 5, right := .default } (zzF1 (zv 0)), zStp ?_, Or.inr (by simp [step, target_tm, evalTapePattern, evalTapeExpr])⟩ + zzD5 zK268 +lemma zS258 (zv : zzV) : zzQ ((zK258 zv)) := by zzK1 zK258 zK268 (zS268 (zzF1 (1))) +lemma zS273 (zv : zzV) : zzQ ((zK273 zv)) := by zzK1 zK273 zK268 (zS268 (zzF1 ((zv 0 + 1)))) +lemma zA274 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK269 zv'))) : + zzQ ((zK274 zv)) := by + zzK1 zK274 zK269 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) +lemma zS269 (zv : zzV) : zzQ ((zK269 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK269 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK269 zK273 h_vr (zS273 (zzF1 (zv 0))) + · zzK2 zK269 zK274 h_vr (zA274 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS259 (zv : zzV) : zzQ ((zK259 zv)) := by zzK1 zK259 zK269 (zS269 (zzF2 (1) (zv 0))) +lemma zS242 (zv : zzV) : zzQ ((zK242 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK242 zK258 h_vr (zS258 (fun _ => 0)) + · zzK2 zK242 zK259 h_vr (zS259 (zzF1 (r))) +lemma zS226 (zv : zzV) : zzQ ((zK226 zv)) := by zzK1 zK226 zK242 (zS242 (zzF1 (zv 0))) +lemma zS212 (zv : zzV) : zzQ ((zK212 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK212 zK225 h_vr (zS225 (fun _ => 0)) + · zzK2 zK212 zK226 h_vr (zS226 (zzF1 (r))) +lemma zS201 (zv : zzV) : zzQ ((zK201 zv)) := by zzK1 zK201 zK212 (zS212 (zzF1 (1))) +lemma zS189 (zv : zzV) : zzQ ((zK189 zv)) := by zzK1 zK189 zK201 (zS201 (fun _ => 0)) +lemma zS237 (zv : zzV) : zzQ ((zK237 zv)) := by zzK1 zK237 zK189 (zS189 (fun _ => 0)) +lemma zS222 (zv : zzV) : zzQ ((zK222 zv)) := by zzK1 zK222 zK237 (zS237 (fun _ => 0)) +lemma zS209 (zv : zzV) : zzQ ((zK209 zv)) := by zzK1 zK209 zK222 (zS222 (fun _ => 0)) +lemma zS199 (zv : zzV) : zzQ ((zK199 zv)) := by zzK1 zK199 zK209 (zS209 (fun _ => 0)) +lemma zS181 (zv : zzV) : zzQ ((zK181 zv)) := by zzK1 zK181 zK199 (zS199 (fun _ => 0)) +lemma zS229 (zv : zzV) : zzQ ((zK229 zv)) := by zzK1 zK229 zP245 (step_to_ps_245 (zzF1 (zv 0))) +lemma zS261 (zv : zzV) : zzQ ((zK261 zv)) := by zzK1 zK261 zP271 (step_to_ps_271 (zzF2 (1) (zv 0))) +lemma zS277 (zv : zzV) : zzQ ((zK277 zv)) := by zzK1 zK277 zP271 (step_to_ps_271 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA278 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK272 zv'))) : + zzQ ((zK278 zv)) := by + zzK1 zK278 zK272 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS272 (zv : zzV) : zzQ ((zK272 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK272 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK272 zK277 h_vr (zS277 (zzF2 (zv 0) (zv 2))) + · zzK2 zK272 zK278 h_vr (zA278 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS262 (zv : zzV) : zzQ ((zK262 zv)) := by zzK1 zK262 zK272 (zS272 (zzF3 (1) (zv 0) (zv 1))) +lemma zS246 (zv : zzV) : zzQ ((zK246 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK246 zK261 h_vr (zS261 (zzF1 (zv 1))) + · zzK2 zK246 zK262 h_vr (zS262 (zzF2 (r) (zv 1))) +lemma zS230 (zv : zzV) : zzQ ((zK230 zv)) := by zzK1 zK230 zK246 (zS246 (zzF2 (zv 0) (zv 1))) +lemma zS215 (zv : zzV) : zzQ ((zK215 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK215 zK229 h_vr (zS229 (zzF1 (zv 1))) + · zzK2 zK215 zK230 h_vr (zS230 (zzF2 (r) (zv 1))) +lemma zS203 (zv : zzV) : zzQ ((zK203 zv)) := by zzK1 zK203 zK215 (zS215 (zzF2 (1) (zv 0))) +lemma zS191 (zv : zzV) : zzQ ((zK191 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK191 zK201 h_vr (zS201 (fun _ => 0)) + · zzK2 zK191 zK203 h_vr (zS203 (zzF1 (r))) +lemma zS267 (zv : zzV) : zzQ ((zK267 zv)) := by zzK1 zK267 zK191 (zS191 (zzF1 ((zv 0 + 1)))) +lemma zS257 (zv : zzV) : zzQ ((zK257 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK257 zK237 h_vr (zS237 (fun _ => 0)) + · zzK2 zK257 zK267 h_vr (zS267 (zzF1 (r))) +lemma zS238 (zv : zzV) : zzQ ((zK238 zv)) := by zzK1 zK238 zK257 (zS257 (zzF1 (zv 0))) +lemma zS223 (zv : zzV) : zzQ ((zK223 zv)) := by zzK1 zK223 zK238 (zS238 (zzF1 (zv 0))) +lemma zS210 (zv : zzV) : zzQ ((zK210 zv)) := by zzK1 zK210 zK223 (zS223 (zzF1 (1))) +lemma zS239 (zv : zzV) : zzQ ((zK239 zv)) := by zzK1 zK239 zK223 (zS223 (zzF1 ((zv 0 + 1)))) +lemma zA240 (zv : zzV) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK224 zv'))) : + zzQ ((zK240 zv)) := by + zzK1 zK240 zK224 (h_u (zzF2 (zv 0) ((zv 1 + 1))) (by (try simp only []); omega)) +lemma zS224 (zv : zzV) : zzQ ((zK224 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK224 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK224 zK239 h_vl (zS239 (zzF1 (zv 1))) + · zzK2 zK224 zK240 h_vl (zA240 (zzF2 (l) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS211 (zv : zzV) : zzQ ((zK211 zv)) := by zzK1 zK211 zK224 (zS224 (zzF2 (zv 0) (1))) +lemma zS200 (zv : zzV) : zzQ ((zK200 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK200 zK210 h_vl (zS210 (fun _ => 0)) + · zzK2 zK200 zK211 h_vl (zS211 (zzF1 (l))) +lemma zS182 (zv : zzV) : zzQ ((zK182 zv)) := by zzK1 zK182 zK200 (zS200 (zzF1 (zv 0))) +lemma zS167 (zv : zzV) : zzQ ((zK167 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK167 zK181 h_vl (zS181 (fun _ => 0)) + · zzK2 zK167 zK182 h_vl (zS182 (zzF1 (l))) +lemma zS157 (zv : zzV) : zzQ ((zK157 zv)) := by zzK1 zK157 zK167 (zS167 (zzF1 (1))) +lemma zS149 (zv : zzV) : zzQ ((zK149 zv)) := by zzK1 zK149 zK157 (zS157 (fun _ => 0)) +lemma zS143 (zv : zzV) : zzQ ((zK143 zv)) := by zzK1 zK143 zK149 (zS149 (fun _ => 0)) +lemma zS183 (zv : zzV) : zzQ ((zK183 zv)) := by zzK1 zK183 zK167 (zS167 (zzF1 ((zv 0 + 1)))) +lemma zS168 (zv : zzV) : zzQ ((zK168 zv)) := by zzK1 zK168 zK183 (zS183 (zzF1 (zv 0))) +lemma zS158 (zv : zzV) : zzQ ((zK158 zv)) := by zzK1 zK158 zK168 (zS168 (zzF1 (1))) +lemma zS184 (zv : zzV) : zzQ ((zK184 zv)) := by zzK1 zK184 zK168 (zS168 (zzF1 ((zv 0 + 1)))) +lemma zA185 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK169 zv'))) : + zzQ ((zK185 zv)) := by + zzK1 zK185 zK169 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) +lemma zS169 (zv : zzV) : zzQ ((zK169 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK169 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK169 zK184 h_vr (zS184 (zzF1 (zv 0))) + · zzK2 zK169 zK185 h_vr (zA185 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS159 (zv : zzV) : zzQ ((zK159 zv)) := by zzK1 zK159 zK169 (zS169 (zzF2 (1) (zv 0))) +lemma zS150 (zv : zzV) : zzQ ((zK150 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK150 zK158 h_vr (zS158 (fun _ => 0)) + · zzK2 zK150 zK159 h_vr (zS159 (zzF1 (r))) +lemma zS144 (zv : zzV) : zzQ ((zK144 zv)) := by zzK1 zK144 zK150 (zS150 (zzF1 (zv 0))) +lemma zS139 (zv : zzV) : zzQ ((zK139 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK139 zK143 h_vr (zS143 (fun _ => 0)) + · zzK2 zK139 zK144 h_vr (zS144 (zzF1 (r))) +lemma zS135 (zv : zzV) : zzQ ((zK135 zv)) := by zzK1 zK135 zK139 (zS139 (zzF1 ((zv 0 + 1)))) +lemma zS131 (zv : zzV) : zzQ ((zK131 zv)) := by zzK1 zK131 zK135 (zS135 (zzF1 (1))) +lemma zS127 (zv : zzV) : zzQ ((zK127 zv)) := by zzK1 zK127 zK131 (zS131 (fun _ => 0)) +lemma zS123 (zv : zzV) : zzQ ((zK123 zv)) := by zzK1 zK123 zK127 (zS127 (fun _ => 0)) +lemma zS136 (zv : zzV) : zzQ ((zK136 zv)) := by zzK1 zK136 zP140 (step_to_ps_140 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS132 (zv : zzV) : zzQ ((zK132 zv)) := by zzK1 zK132 zK136 (zS136 (zzF2 (1) (zv 0))) +lemma zS128 (zv : zzV) : zzQ ((zK128 zv)) := by zzK1 zK128 zK132 (zS132 (zzF1 (zv 0))) +lemma zS124 (zv : zzV) : zzQ ((zK124 zv)) := by zzK1 zK124 zK128 (zS128 (zzF1 (zv 0))) +lemma zS121 (zv : zzV) : zzQ ((zK121 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK121 zK123 h_vr (zS123 (fun _ => 0)) + · zzK2 zK121 zK124 h_vr (zS124 (zzF1 (r))) +lemma zS119 (zv : zzV) : zzQ ((zK119 zv)) := by zzK1 zK119 zK121 (zS121 (zzF1 (zv 0))) +lemma zS227 (zv : zzV) : zzQ ((zK227 zv)) := by zzK1 zK227 zK212 (zS212 (zzF1 ((zv 0 + 1)))) +lemma zS213 (zv : zzV) : zzQ ((zK213 zv)) := by zzK1 zK213 zK227 (zS227 (zzF1 (1))) +lemma zS243 (zv : zzV) : zzQ ((zK243 zv)) := by zzK1 zK243 zK227 (zS227 (zzF1 ((zv 0 + 1)))) +lemma zA244 (zv : zzV) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK228 zv'))) : + zzQ ((zK244 zv)) := by + zzK1 zK244 zK228 (h_u (zzF2 (zv 0) ((zv 1 + 1))) (by (try simp only []); omega)) +lemma zS228 (zv : zzV) : zzQ ((zK228 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK228 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK228 zK243 h_vl (zS243 (zzF1 (zv 1))) + · zzK2 zK228 zK244 h_vl (zA244 (zzF2 (l) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS214 (zv : zzV) : zzQ ((zK214 zv)) := by zzK1 zK214 zK228 (zS228 (zzF2 (zv 0) (1))) +lemma zS202 (zv : zzV) : zzQ ((zK202 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK202 zK213 h_vl (zS213 (fun _ => 0)) + · zzK2 zK202 zK214 h_vl (zS214 (zzF1 (l))) +lemma zS190 (zv : zzV) : zzQ ((zK190 zv)) := by zzK1 zK190 zK202 (zS202 (zzF1 (zv 0))) +lemma zS173 (zv : zzV) : zzQ ((zK173 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK173 zK189 h_vl (zS189 (fun _ => 0)) + · zzK2 zK173 zK190 h_vl (zS190 (zzF1 (l))) +lemma zS231 (zv : zzV) : zzQ ((zK231 zv)) := by zzK1 zK231 zK215 (zS215 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS216 (zv : zzV) : zzQ ((zK216 zv)) := by zzK1 zK216 zK231 (zS231 (zzF2 (1) (zv 0))) +lemma zS247 (zv : zzV) : zzQ ((zK247 zv)) := by zzK1 zK247 zK231 (zS231 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA248 (zv : zzV) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK232 zv'))) : + zzQ ((zK248 zv)) := by + zzK1 zK248 zK232 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS232 (zv : zzV) : zzQ ((zK232 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK232 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK232 zK247 h_vl (zS247 (zzF2 (zv 1) (zv 2))) + · zzK2 zK232 zK248 h_vl (zA248 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS217 (zv : zzV) : zzQ ((zK217 zv)) := by zzK1 zK217 zK232 (zS232 (zzF3 (zv 0) (1) (zv 1))) +lemma zS204 (zv : zzV) : zzQ ((zK204 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK204 zK216 h_vl (zS216 (zzF1 (zv 1))) + · zzK2 zK204 zK217 h_vl (zS217 (zzF2 (l) (zv 1))) +lemma zS192 (zv : zzV) : zzQ ((zK192 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK192 zK202 h_vr (zS202 (zzF1 (zv 0))) + · zzK2 zK192 zK204 h_vr (zS204 (zzF2 (zv 0) (r))) +lemma zS174 (zv : zzV) : zzQ ((zK174 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK174 zK191 h_vl (zS191 (zzF1 ((zv 1 + 1)))) + · zzK2 zK174 zK192 h_vl (zS192 (zzF2 (l) ((zv 1 + 1)))) +lemma zS163 (zv : zzV) : zzQ ((zK163 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK163 zK173 h_vr (zS173 (zzF1 (1))) + · zzK2 zK163 zK174 h_vr (zS174 (zzF2 (1) (r))) +lemma zS153 (zv : zzV) : zzQ ((zK153 zv)) := by zzK1 zK153 zK163 (zS163 (zzF1 (zv 0))) +lemma zS193 (zv : zzV) : zzQ ((zK193 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK193 zK173 h_vr (zS173 (zzF1 ((zv 0 + 1)))) + · zzK2 zK193 zK174 h_vr (zS174 (zzF2 ((zv 0 + 1)) (r))) +lemma zS175 (zv : zzV) : zzQ ((zK175 zv)) := by zzK1 zK175 zK193 (zS193 (zzF2 (zv 0) (zv 1))) +lemma zA194 (zv : zzV) + (h_u : ∀ zv', zv' 1 < zv 1 -> zzQ ((zK176 zv'))) : + zzQ ((zK194 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK194 zK175 h_vr (zS175 (zzF2 ((zv 0 + 1)) (zv 2))) + · zzK2 zK194 zK176 h_vr (h_u (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) +lemma zS176 (zv : zzV) : zzQ ((zK176 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK176 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK176 zK194 (zA194 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS164 (zv : zzV) : zzQ ((zK164 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK164 zK175 h_vr (zS175 (zzF2 (1) (zv 1))) + · zzK2 zK164 zK176 h_vr (zS176 (zzF3 (1) (r) (zv 1))) +lemma zS154 (zv : zzV) : zzQ ((zK154 zv)) := by zzK1 zK154 zK164 (zS164 (zzF2 (zv 0) (zv 1))) +lemma zS147 (zv : zzV) : zzQ ((zK147 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK147 zK153 h_vr (zS153 (zzF1 (zv 1))) + · zzK2 zK147 zK154 h_vr (zS154 (zzF2 (r) (zv 1))) +lemma zS141 (zv : zzV) : zzQ ((zK141 zv)) := by zzK1 zK141 zK147 (zS147 (zzF2 (zv 0) (zv 1))) +lemma zS137 (zv : zzV) : zzQ ((zK137 zv)) := by zzK1 zK137 zK141 (zS141 (zzF2 (zv 0) (zv 1))) +lemma zS133 (zv : zzV) : zzQ ((zK133 zv)) := by zzK1 zK133 zK137 (zS137 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS129 (zv : zzV) : zzQ ((zK129 zv)) := by zzK1 zK129 zK133 (zS133 (zzF2 (1) (zv 0))) +lemma zS125 (zv : zzV) : zzQ ((zK125 zv)) := by zzK1 zK125 zK129 (zS129 (zzF1 (zv 0))) +lemma zS263 (zv : zzV) : zzQ ((zK263 zv)) := by zzK1 zK263 zK135 (zS135 (zzF1 ((zv 0 + 1)))) +lemma zS249 (zv : zzV) : zzQ ((zK249 zv)) := by zzK1 zK249 zK263 (zS263 (zzF1 (zv 0))) +lemma zA264 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK250 zv'))) : + zzQ ((zK264 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK264 zK249 h_vl (zS249 (zzF1 ((zv 1 + 1)))) + · zzK2 zK264 zK250 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) +lemma zS250 (zv : zzV) : zzQ ((zK250 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK250 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK250 zK264 (zA264 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS233 (zv : zzV) : zzQ ((zK233 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK233 zK249 h_vl (zS249 (zzF1 (1))) + · zzK2 zK233 zK250 h_vl (zS250 (zzF2 (l) (1))) +lemma zS218 (zv : zzV) : zzQ ((zK218 zv)) := by zzK1 zK218 zK233 (zS233 (zzF1 (zv 0))) +lemma zS205 (zv : zzV) : zzQ ((zK205 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK205 zK127 h_vl (zS127 (fun _ => 0)) + · zzK2 zK205 zK218 h_vl (zS218 (zzF1 (l))) +lemma zS265 (zv : zzV) : zzQ ((zK265 zv)) := by zzK1 zK265 zK136 (zS136 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS251 (zv : zzV) : zzQ ((zK251 zv)) := by zzK1 zK251 zK265 (zS265 (zzF2 (zv 0) (zv 1))) +lemma zA266 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK252 zv'))) : + zzQ ((zK266 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK266 zK251 h_vl (zS251 (zzF2 ((zv 1 + 1)) (zv 2))) + · zzK2 zK266 zK252 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS252 (zv : zzV) : zzQ ((zK252 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK252 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK252 zK266 (zA266 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS234 (zv : zzV) : zzQ ((zK234 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK234 zK251 h_vl (zS251 (zzF2 (1) (zv 1))) + · zzK2 zK234 zK252 h_vl (zS252 (zzF3 (l) (1) (zv 1))) +lemma zS219 (zv : zzV) : zzQ ((zK219 zv)) := by zzK1 zK219 zK234 (zS234 (zzF2 (zv 0) (zv 1))) +lemma zS206 (zv : zzV) : zzQ ((zK206 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK206 zK128 h_vl (zS128 (zzF1 (zv 1))) + · zzK2 zK206 zK219 h_vl (zS219 (zzF2 (l) (zv 1))) +lemma zS195 (zv : zzV) : zzQ ((zK195 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK195 zK205 h_vr (zS205 (zzF1 (zv 0))) + · zzK2 zK195 zK206 h_vr (zS206 (zzF2 (zv 0) (r))) +lemma zS177 (zv : zzV) : zzQ ((zK177 zv)) := by zzK1 zK177 zK195 (zS195 (zzF2 (zv 0) (zv 1))) +lemma zS253 (zv : zzV) : zzQ ((zK253 zv)) := by zzK1 zK253 zK133 (zS133 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA254 (zv : zzV) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK235 zv'))) : + zzQ ((zK254 zv)) := by + zzK1 zK254 zK235 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS235 (zv : zzV) : zzQ ((zK235 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK235 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK235 zK253 h_vl (zS253 (zzF2 (zv 1) (zv 2))) + · zzK2 zK235 zK254 h_vl (zA254 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS220 (zv : zzV) : zzQ ((zK220 zv)) := by zzK1 zK220 zK235 (zS235 (zzF3 (zv 0) (1) (zv 1))) +lemma zS207 (zv : zzV) : zzQ ((zK207 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK207 zK129 h_vl (zS129 (zzF1 (zv 1))) + · zzK2 zK207 zK220 h_vl (zS220 (zzF2 (l) (zv 1))) +lemma zS196 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK196 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK196 zK207 h_vr (zS207 (zzF2 (zv 0) (zv 2))) + · zzK2 zK196 zP208 h_vr (h_208 (zzF3 (zv 0) (r) (zv 2)) (by (try simp only []); omega)) +lemma zS178 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK178 zv)) := by zzK1 zK178 zK196 (zS196 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS165 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK165 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK165 zK177 h_vr (zS177 (zzF2 (1) (zv 1))) + · zzK2 zK165 zK178 h_vr (zS178 B h_208 (zzF3 (1) (r) (zv 1)) (by (try simp only []); omega)) +lemma zS155 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK155 zv)) := by zzK1 zK155 zK165 (zS165 B h_208 (zzF2 (zv 0) (zv 1)) (by (try simp only []); omega)) +lemma zS197 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK197 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK197 zK177 h_vr (zS177 (zzF2 ((zv 0 + 1)) (zv 2))) + · zzK2 zK197 zK178 h_vr (zS178 B h_208 (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) +lemma zS179 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK179 zv)) := by zzK1 zK179 zK197 (zS197 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zA198 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) + (h_u : ∀ zv', zv' 1 < zv 1 -> zv' 2 <= B -> zzQ ((zK180 zv'))) : + zzQ ((zK198 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK198 zK179 h_vr (zS179 B h_208 (zzF3 ((zv 0 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega)) + · zzK2 zK198 zK180 h_vr (h_u (zzF4 ((zv 0 + 1)) (r) (zv 2) (zv 3)) (by (try simp only []); omega) (by (try simp only []); omega)) +lemma zS180 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) : zzQ ((zK180 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zv 2 <= B -> zzQ ((zK180 zv)) from h_ind (zv 1) zv rfl h_B + intro n + refine Nat.strongRecOn n (fun n ih zv h_n h_B => ?_) + zzK1 zK180 zK198 (zA198 B h_208 (zzF4 (zv 0) (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega) (fun zv' h_le h_B' => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl h_B')) +lemma zS166 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK166 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK166 zK179 h_vr (zS179 B h_208 (zzF3 (1) (zv 1) (zv 2)) (by (try simp only []); omega)) + · zzK2 zK166 zK180 h_vr (zS180 B h_208 (zzF4 (1) (r) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS156 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK156 zv)) := by zzK1 zK156 zK166 (zS166 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS148 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK148 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK148 zK155 h_vr (zS155 B h_208 (zzF2 (zv 1) (zv 2)) (by (try simp only []); omega)) + · zzK2 zK148 zK156 h_vr (zS156 B h_208 (zzF3 (r) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS142 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK142 zv)) := by zzK1 zK142 zK148 (zS148 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS138 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK138 zv)) := by zzK1 zK138 zK142 (zS142 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS134 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK134 zv)) := by zzK1 zK134 zK138 (zS138 B h_208 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zA130 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK130 zv)) := by zzK1 zK130 zK134 (zS134 B h_208 (zzF3 (1) (zv 0) (zv 1)) (by (try simp only []); omega)) +lemma zS255 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK255 zv)) := by zzK1 zK255 zK134 (zS134 B h_208 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zA256 (zv : zzV) (B : Nat) (h_B : zv 2 <= B) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zv' 2 <= B -> zzQ ((zK236 zv'))) : + zzQ ((zK256 zv)) := by + zzK1 zK256 zK236 (h_u (zzF4 (zv 0) ((zv 1 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega) (by (try simp only []); omega)) +lemma zS236 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) : zzQ ((zK236 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zv 2 <= B -> zzQ ((zK236 zv)) from h_ind (zv 0) zv rfl h_B + intro n + refine Nat.strongRecOn n (fun n ih zv h_n h_B => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK236 zK255 h_vl (zS255 B h_208 (zzF3 (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega)) + · zzK2 zK236 zK256 h_vl (zA256 (zzF4 (l) (zv 1) (zv 2) (zv 3)) B (by (try simp only []); omega) (fun zv' h_le h_B' => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl h_B')) +lemma zS221 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK221 zv)) := by zzK1 zK221 zK236 (zS236 B h_208 (zzF4 (zv 0) (1) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma step_hub_208 (zv : zzV) : zzQ ((zzE zP208 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zzE zP208 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zP208 zK130 h_vl (zA130 n (fun zv' h_lt => ih (zv' 1) h_lt zv' rfl) (zzF2 (zv 1) (zv 2)) (by (try simp only []); omega)) + · zzK2 zP208 zK221 h_vl (zS221 n (fun zv' h_lt => ih (zv' 1) h_lt zv' rfl) (zzF3 (l) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS130 (zv : zzV) : + zzQ ((zK130 zv)) := + zA130 (zv 0) (fun zv' _ => step_hub_208 zv') zv (Nat.le_refl _) +lemma zS126 (zv : zzV) : zzQ ((zK126 zv)) := by zzK1 zK126 zK130 (zS130 (zzF2 (zv 0) (zv 1))) +lemma zS122 (zv : zzV) : zzQ ((zK122 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK122 zK125 h_vr (zS125 (zzF1 (zv 1))) + · zzK2 zK122 zK126 h_vr (zS126 (zzF2 (r) (zv 1))) +lemma zS120 (zv : zzV) : zzQ ((zK120 zv)) := by zzK1 zK120 zK122 (zS122 (zzF2 (zv 0) (zv 1))) +lemma zS118 (zv : zzV) : zzQ ((zK118 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK118 zK119 h_vr (zS119 (zzF1 (zv 1))) + · zzK2 zK118 zK120 h_vr (zS120 (zzF2 (r) (zv 1))) +lemma zS116 (zv : zzV) : zzQ ((zK116 zv)) := by zzK1 zK116 zK118 (zS118 (zzF2 (zv 0) (zv 1))) +lemma zS114 (zv : zzV) : zzQ ((zK114 zv)) := by zzK1 zK114 zK116 (zS116 (zzF2 (zv 0) (zv 1))) +lemma zS111 (zv : zzV) : zzQ ((zK111 zv)) := by zzK1 zK111 zK114 (zS114 (zzF2 (1) (zv 0))) +lemma zS108 (zv : zzV) : zzQ ((zK108 zv)) := by zzK1 zK108 zK111 (zS111 (zzF1 (zv 0))) +lemma zS106 (zv : zzV) : zzQ ((zK106 zv)) := by zzK1 zK106 zK108 (zS108 (zzF1 (zv 0))) +lemma zS104 (zv : zzV) : zzQ ((zK104 zv)) := by zzK1 zK104 zK106 (zS106 (zzF1 (zv 0))) +lemma zS117 (zv : zzV) : zzQ ((zK117 zv)) := by zzK1 zK117 zK114 (zS114 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS115 (zv : zzV) : zzQ ((zK115 zv)) := by zzK1 zK115 zK117 (zS117 (zzF2 (zv 0) (zv 1))) +lemma zS112 (zv : zzV) : zzQ ((zK112 zv)) := by zzK1 zK112 zK115 (zS115 (zzF2 (zv 0) (zv 1))) +lemma zS109 (zv : zzV) : zzQ ((zK109 zv)) := by zzK1 zK109 zK112 (zS112 (zzF2 (zv 0) (zv 1))) +lemma zA113 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK110 zv'))) : + zzQ ((zK113 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK113 zK109 h_vl (zS109 (zzF2 ((zv 1 + 1)) (zv 2))) + · zzK2 zK113 zK110 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS110 (zv : zzV) : zzQ ((zK110 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK110 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK110 zK113 (zA113 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS107 (zv : zzV) : zzQ ((zK107 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK107 zK109 h_vl (zS109 (zzF2 (1) (zv 1))) + · zzK2 zK107 zK110 h_vl (zS110 (zzF3 (l) (1) (zv 1))) +lemma zS105 (zv : zzV) : zzQ ((zK105 zv)) := by zzK1 zK105 zK107 (zS107 (zzF2 (zv 0) (zv 1))) +lemma zS103 (zv : zzV) : zzQ ((zK103 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK103 zK104 h_vl (zS104 (zzF1 (zv 1))) + · zzK2 zK103 zK105 h_vl (zS105 (zzF2 (l) (zv 1))) +lemma zS102 (zv : zzV) : zzQ ((zK102 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK102 zK19 h_vr (zS19 (zzF1 (1))) + · zzK2 zK102 zK103 h_vr (zS103 (zzF2 (1) (r))) +lemma zS101 (zv : zzV) : zzQ ((zK101 zv)) := by zzK1 zK101 zK102 (zS102 (zzF1 (zv 0))) +lemma zS100 (zv : zzV) : zzQ ((zK100 zv)) := by zzK1 zK100 zK101 (zS101 (zzF1 (zv 0))) +lemma zS99 (zv : zzV) : zzQ ((zK99 zv)) := by zzK1 zK99 zK100 (zS100 (zzF1 (zv 0))) +lemma zS98 (zv : zzV) : zzQ ((zK98 zv)) := by zzK1 zK98 zK99 (zS99 (zzF1 (zv 0))) +lemma zS97 (zv : zzV) : zzQ ((zK97 zv)) := by zzK1 zK97 zK98 (zS98 (zzF1 (zv 0))) +lemma zS96 (zv : zzV) : zzQ ((zK96 zv)) := by zzK1 zK96 zK97 (zS97 (zzF1 (zv 0))) +lemma zS95 (zv : zzV) : zzQ ((zK95 zv)) := by zzK1 zK95 zK96 (zS96 (zzF1 (zv 0))) +lemma zS94 (zv : zzV) : zzQ ((zK94 zv)) := by zzK1 zK94 zK95 (zS95 (zzF1 (zv 0))) +lemma zS90 (zv : zzV) : zzQ ((zK90 zv)) := by zzK1 zK90 zK94 (zS94 (zzF1 (zv 0))) +lemma zS86 (zv : zzV) : zzQ ((zK86 zv)) := by zzK1 zK86 zK90 (zS90 (zzF1 (zv 0))) +lemma zA91 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK87 zv'))) : + zzQ ((zK91 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK91 zK86 h_vl (zS86 (zzF1 ((zv 1 + 1)))) + · zzK2 zK91 zK87 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) +lemma zS87 (zv : zzV) : zzQ ((zK87 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK87 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK87 zK91 (zA91 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS84 (zv : zzV) : zzQ ((zK84 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK84 zK86 h_vl (zS86 (zzF1 (1))) + · zzK2 zK84 zK87 h_vl (zS87 (zzF2 (l) (1))) +lemma zS82 (zv : zzV) : zzQ ((zK82 zv)) := by zzK1 zK82 zK84 (zS84 (zzF1 (zv 0))) +lemma zS79 (zv : zzV) : zzQ ((zK79 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK79 zK3 h_vl (zS3 (fun _ => 0)) + · zzK2 zK79 zK82 h_vl (zS82 (zzF1 (l))) +lemma zS72 (zv : zzV) : zzQ ((zK72 zv)) := by zzK1 zK72 zK79 (zS79 (zzF1 (zv 0))) +lemma zS67 (zv : zzV) : zzQ ((zK67 zv)) := by zzK1 zK67 zK72 (zS72 (zzF1 (zv 0))) +lemma zS62 (zv : zzV) : zzQ ((zK62 zv)) := by zzK1 zK62 zK67 (zS67 (zzF1 (1))) +lemma zS59 (zv : zzV) : zzQ ((zK59 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK59 zK62 h_vr (zS62 (fun _ => 0)) + · zzKB2 zK59 zK63 h_vr (zI63 (zzF1 (r))) +lemma zS56 (zv : zzV) : zzQ ((zK56 zv)) := by zzK1 zK56 zK59 (zS59 (zzF1 (zv 0))) +lemma zS75 (zv : zzV) : zzQ ((zK75 zv)) := by zzK1 zK75 zK67 (zS67 (zzF1 ((zv 0 + 1)))) +lemma zS69 (zv : zzV) : zzQ ((zK69 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK69 zK75 h_vr (zS75 (zzF1 (zv 0))) + · zzKB2 zK69 zK76 h_vr (zI76 (zzF2 (zv 0) (r))) +lemma zS64 (zv : zzV) : zzQ ((zK64 zv)) := by zzK1 zK64 zK69 (zS69 (zzF2 (1) (zv 0))) +lemma zS77 (zv : zzV) : zzQ ((zK77 zv)) := by zzK1 zK77 zK69 (zS69 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA78 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK70 zv'))) : + zzQ ((zK78 zv)) := by + zzK1 zK78 zK70 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS70 (zv : zzV) : zzQ ((zK70 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK70 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK70 zK77 h_vr (zS77 (zzF2 (zv 0) (zv 2))) + · zzK2 zK70 zK78 h_vr (zA78 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS65 (zv : zzV) : zzQ ((zK65 zv)) := by zzK1 zK65 zK70 (zS70 (zzF3 (1) (zv 0) (zv 1))) +lemma zS60 (zv : zzV) : zzQ ((zK60 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK60 zK64 h_vr (zS64 (zzF1 (zv 1))) + · zzK2 zK60 zK65 h_vr (zS65 (zzF2 (r) (zv 1))) +lemma zS57 (zv : zzV) : zzQ ((zK57 zv)) := by zzK1 zK57 zK60 (zS60 (zzF2 (zv 0) (zv 1))) +lemma zS54 (zv : zzV) : zzQ ((zK54 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK54 zK56 h_vr (zS56 (zzF1 (zv 1))) + · zzK2 zK54 zK57 h_vr (zS57 (zzF2 (r) (zv 1))) +lemma zS52 (zv : zzV) : zzQ ((zK52 zv)) := by zzK1 zK52 zK54 (zS54 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS50 (zv : zzV) : zzQ ((zK50 zv)) := by zzK1 zK50 zK52 (zS52 (zzF2 (1) (zv 0))) +lemma zS48 (zv : zzV) : zzQ ((zK48 zv)) := by zzK1 zK48 zK50 (zS50 (zzF1 (zv 0))) +lemma zS46 (zv : zzV) : zzQ ((zK46 zv)) := by zzK1 zK46 zK48 (zS48 (zzF1 (zv 0))) +lemma zS43 (zv : zzV) : zzQ ((zK43 zv)) := by zzK1 zK43 zK46 (zS46 (zzF1 (zv 0))) +lemma zS38 (zv : zzV) : zzQ ((zK38 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK38 zK42 h_vr (zS42 (fun _ => 0)) + · zzK2 zK38 zK43 h_vr (zS43 (zzF1 (r))) +lemma zS34 (zv : zzV) : zzQ ((zK34 zv)) := by zzK1 zK34 zK38 (zS38 (zzF1 (zv 0))) +lemma zS71 (zv : zzV) : zzQ ((zK71 zv)) := by zzKB1 zK71 zP66 (zI66 (zzF1 ((zv 0 + 1)))) +lemma zA80 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK73 zv'))) : + zzQ ((zK80 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK80 zK47 h_vl (zS47 (fun _ => 0)) + · zzK2 zK80 zK73 h_vl (h_u (zzF1 (l)) (by (try simp only []); omega)) +lemma zS73 (zv : zzV) : zzQ ((zK73 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK73 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK73 zK80 (zA80 (zzF1 (zv 0)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS92 (zv : zzV) : zzQ ((zK92 zv)) := by zzK1 zK92 zK52 (zS52 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS88 (zv : zzV) : zzQ ((zK88 zv)) := by zzK1 zK88 zK92 (zS92 (zzF2 (zv 0) (zv 1))) +lemma zA93 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK89 zv'))) : + zzQ ((zK93 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK93 zK88 h_vl (zS88 (zzF2 ((zv 1 + 1)) (zv 2))) + · zzK2 zK93 zK89 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS89 (zv : zzV) : zzQ ((zK89 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK89 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK89 zK93 (zA93 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS85 (zv : zzV) : zzQ ((zK85 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK85 zK88 h_vl (zS88 (zzF2 (1) (zv 1))) + · zzK2 zK85 zK89 h_vl (zS89 (zzF3 (l) (1) (zv 1))) +lemma zS83 (zv : zzV) : zzQ ((zK83 zv)) := by zzK1 zK83 zK85 (zS85 (zzF2 (zv 0) (zv 1))) +lemma zS81 (zv : zzV) : zzQ ((zK81 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK81 zK48 h_vl (zS48 (zzF1 (zv 1))) + · zzK2 zK81 zK83 h_vl (zS83 (zzF2 (l) (zv 1))) +lemma zS74 (zv : zzV) : zzQ ((zK74 zv)) := by zzK1 zK74 zK81 (zS81 (zzF2 (zv 0) (zv 1))) +lemma zS170 (zv : zzV) : zzQ ((zK170 zv)) := by zzK1 zK170 zK104 (zS104 (zzF1 (zv 0))) +lemma zS160 (zv : zzV) : zzQ ((zK160 zv)) := by zzK1 zK160 zK170 (zS170 (zzF1 (zv 0))) +lemma zS151 (zv : zzV) : zzQ ((zK151 zv)) := by zzK1 zK151 zK160 (zS160 (zzF1 (zv 0))) +lemma zS145 (zv : zzV) : zzQ ((zK145 zv)) := by zzK1 zK145 zK151 (zS151 (zzF1 (zv 0))) +lemma zS186 (zv : zzV) : zzQ ((zK186 zv)) := by zzK1 zK186 zK103 (zS103 (zzF2 (zv 0) (zv 1))) +lemma zS171 (zv : zzV) : zzQ ((zK171 zv)) := by zzK1 zK171 zK186 (zS186 (zzF2 (zv 0) (zv 1))) +lemma zS161 (zv : zzV) : zzQ ((zK161 zv)) := by zzK1 zK161 zK171 (zS171 (zzF2 (1) (zv 0))) +lemma zS187 (zv : zzV) : zzQ ((zK187 zv)) := by zzK1 zK187 zK171 (zS171 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA188 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK172 zv'))) : + zzQ ((zK188 zv)) := by + zzK1 zK188 zK172 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS172 (zv : zzV) : zzQ ((zK172 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK172 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK172 zK187 h_vr (zS187 (zzF2 (zv 0) (zv 2))) + · zzK2 zK172 zK188 h_vr (zA188 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS162 (zv : zzV) : zzQ ((zK162 zv)) := by zzK1 zK162 zK172 (zS172 (zzF3 (1) (zv 0) (zv 1))) +lemma zS152 (zv : zzV) : zzQ ((zK152 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK152 zK161 h_vr (zS161 (zzF1 (zv 1))) + · zzK2 zK152 zK162 h_vr (zS162 (zzF2 (r) (zv 1))) +lemma zS146 (zv : zzV) : zzQ ((zK146 zv)) := by zzK1 zK146 zK152 (zS152 (zzF2 (zv 0) (zv 1))) +lemma zS317 (zv : zzV) : zzQ ((zK317 zv)) := by zzK1 zK317 zK28 (zS28 (fun _ => 0)) +lemma zS309 (zv : zzV) : zzQ ((zK309 zv)) := by zzK1 zK309 zK317 (zS317 (fun _ => 0)) +lemma zS310 (zv : zzV) : zzQ ((zK310 zv)) := by zzK1 zK310 zP245 (step_to_ps_245 (zzF1 ((zv 0 + 1)))) +lemma zS305 (zv : zzV) : zzQ ((zK305 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK305 zK309 h_vr (zS309 (fun _ => 0)) + · zzK2 zK305 zK310 h_vr (zS310 (zzF1 (r))) +lemma zS301 (zv : zzV) : zzQ ((zK301 zv)) := by zzK1 zK301 zK305 (zS305 (zzF1 (zv 0))) +lemma zS324 (zv : zzV) : zzQ ((zK324 zv)) := by zzK1 zK324 zP271 (step_to_ps_271 (zzF2 (zv 0) ((zv 1 + 1)))) +lemma zS318 (zv : zzV) : zzQ ((zK318 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK318 zK22 h_vr (zS22 (zzF1 (zv 0))) + · zzK2 zK318 zK324 h_vr (zS324 (zzF2 (zv 0) (r))) +lemma zS311 (zv : zzV) : zzQ ((zK311 zv)) := by zzK1 zK311 zK318 (zS318 (zzF2 (1) (zv 0))) +lemma zS325 (zv : zzV) : zzQ ((zK325 zv)) := by zzK1 zK325 zK318 (zS318 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA326 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK319 zv'))) : + zzQ ((zK326 zv)) := by + zzK1 zK326 zK319 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) +lemma zS319 (zv : zzV) : zzQ ((zK319 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK319 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK319 zK325 h_vr (zS325 (zzF2 (zv 0) (zv 2))) + · zzK2 zK319 zK326 h_vr (zA326 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS312 (zv : zzV) : zzQ ((zK312 zv)) := by zzK1 zK312 zK319 (zS319 (zzF3 (1) (zv 0) (zv 1))) +lemma zS306 (zv : zzV) : zzQ ((zK306 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK306 zK311 h_vr (zS311 (zzF1 (zv 1))) + · zzK2 zK306 zK312 h_vr (zS312 (zzF2 (r) (zv 1))) +lemma zS302 (zv : zzV) : zzQ ((zK302 zv)) := by zzK1 zK302 zK306 (zS306 (zzF2 (zv 0) (zv 1))) +lemma zS299 (zv : zzV) : zzQ ((zK299 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK299 zK301 h_vr (zS301 (zzF1 (zv 1))) + · zzK2 zK299 zK302 h_vr (zS302 (zzF2 (r) (zv 1))) +lemma zS297 (zv : zzV) : zzQ ((zK297 zv)) := by zzK1 zK297 zK299 (zS299 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS295 (zv : zzV) : zzQ ((zK295 zv)) := by zzK1 zK295 zK297 (zS297 (zzF2 (1) (zv 0))) +lemma zS293 (zv : zzV) : zzQ ((zK293 zv)) := by zzK1 zK293 zK295 (zS295 (zzF1 (zv 0))) +lemma zS291 (zv : zzV) : zzQ ((zK291 zv)) := by zzK1 zK291 zK293 (zS293 (zzF1 (zv 0))) +lemma zS289 (zv : zzV) : zzQ ((zK289 zv)) := by zzK1 zK289 zK291 (zS291 (zzF1 (zv 0))) +lemma zS361 (zv : zzV) : zzQ ((zK361 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK361 zK19 h_vr (zS19 (zzF1 ((zv 0 + 1)))) + · zzK2 zK361 zK103 h_vr (zS103 (zzF2 ((zv 0 + 1)) (r))) +lemma zS359 (zv : zzV) : zzQ ((zK359 zv)) := by zzK1 zK359 zK361 (zS361 (zzF2 (zv 0) (zv 1))) +lemma zA362 (zv : zzV) + (h_u : ∀ zv', zv' 1 < zv 1 -> zzQ ((zK360 zv'))) : + zzQ ((zK362 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK362 zK359 h_vr (zS359 (zzF2 ((zv 0 + 1)) (zv 2))) + · zzK2 zK362 zK360 h_vr (h_u (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) +lemma zS360 (zv : zzV) : zzQ ((zK360 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK360 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK360 zK362 (zA362 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS358 (zv : zzV) : zzQ ((zK358 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK358 zK359 h_vr (zS359 (zzF2 (1) (zv 1))) + · zzK2 zK358 zK360 h_vr (zS360 (zzF3 (1) (r) (zv 1))) +lemma zS357 (zv : zzV) : zzQ ((zK357 zv)) := by zzK1 zK357 zK358 (zS358 (zzF2 (zv 0) (zv 1))) +lemma zS352 (zv : zzV) : zzQ ((zK352 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK352 zK101 h_vr (zS101 (zzF1 (zv 1))) + · zzK2 zK352 zK357 h_vr (zS357 (zzF2 (r) (zv 1))) +lemma zS345 (zv : zzV) : zzQ ((zK345 zv)) := by zzK1 zK345 zK352 (zS352 (zzF2 (zv 0) (zv 1))) +lemma zS341 (zv : zzV) : zzQ ((zK341 zv)) := by zzK1 zK341 zK345 (zS345 (zzF2 (zv 0) (zv 1))) +lemma zS337 (zv : zzV) : zzQ ((zK337 zv)) := by zzK1 zK337 zK341 (zS341 (zzF2 (1) (zv 0))) +lemma zS346 (zv : zzV) : zzQ ((zK346 zv)) := by zzK1 zK346 zK341 (zS341 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zA347 (zv : zzV) + (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK342 zv'))) : + zzQ ((zK347 zv)) := by + zzK1 zK347 zK342 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS342 (zv : zzV) : zzQ ((zK342 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK342 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vl : zv 0 with _ | l + · zzK2 zK342 zK346 h_vl (zS346 (zzF2 (zv 1) (zv 2))) + · zzK2 zK342 zK347 h_vl (zA347 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS338 (zv : zzV) : zzQ ((zK338 zv)) := by zzK1 zK338 zK342 (zS342 (zzF3 (zv 0) (1) (zv 1))) +lemma zS334 (zv : zzV) : zzQ ((zK334 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK334 zK337 h_vl (zS337 (zzF1 (zv 1))) + · zzK2 zK334 zK338 h_vl (zS338 (zzF2 (l) (zv 1))) +lemma zS327 (zv : zzV) : zzQ ((zK327 zv)) := by zzK1 zK327 zK334 (zS334 (zzF2 (zv 0) (zv 1))) +lemma zS320 (zv : zzV) : zzQ ((zK320 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK320 zK97 h_vl (zS97 (zzF1 (zv 1))) + · zzK2 zK320 zK327 h_vl (zS327 (zzF2 (l) (zv 1))) +lemma zS313 (zv : zzV) : zzQ ((zK313 zv)) := by zzK1 zK313 zK320 (zS320 (zzF2 (1) (zv 0))) +lemma zS307 (zv : zzV) : zzQ ((zK307 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK307 zK313 h_vr (zS313 (zzF1 (zv 1))) + · zzKB2 zK307 zK314 h_vr (zI314 (zzF2 (r) (zv 1))) +lemma zS303 (zv : zzV) : zzQ ((zK303 zv)) := by zzK1 zK303 zK307 (zS307 (zzF2 (zv 0) (zv 1))) +lemma zS330 (zv : zzV) : zzQ ((zK330 zv)) := by zzK1 zK330 zK320 (zS320 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS322 (zv : zzV) : zzQ ((zK322 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zK322 zK330 h_vr (zS330 (zzF2 (zv 0) (zv 2))) + · zzKB2 zK322 zK331 h_vr (zI331 (zzF3 (zv 0) (r) (zv 2))) +lemma zS315 (zv : zzV) : zzQ ((zK315 zv)) := by zzK1 zK315 zK322 (zS322 (zzF3 (1) (zv 0) (zv 1))) +lemma zS332 (zv : zzV) : zzQ ((zK332 zv)) := by zzK1 zK332 zK322 (zS322 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) +lemma zA333 (zv : zzV) + (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK323 zv'))) : + zzQ ((zK333 zv)) := by + zzK1 zK333 zK323 (h_u (zzF4 ((zv 0 + 1)) (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega)) +lemma zS323 (zv : zzV) : zzQ ((zK323 zv)) := by + suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK323 zv)) from h_ind (zv 1) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + rcases h_vr : zv 1 with _ | r + · zzK2 zK323 zK332 h_vr (zS332 (zzF3 (zv 0) (zv 2) (zv 3))) + · zzK2 zK323 zK333 h_vr (zA333 (zzF4 (zv 0) (r) (zv 2) (zv 3)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS316 (zv : zzV) : zzQ ((zK316 zv)) := by zzK1 zK316 zK323 (zS323 (zzF4 (1) (zv 0) (zv 1) (zv 2))) +lemma zS308 (zv : zzV) : zzQ ((zK308 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK308 zK315 h_vr (zS315 (zzF2 (zv 1) (zv 2))) + · zzK2 zK308 zK316 h_vr (zS316 (zzF3 (r) (zv 1) (zv 2))) +lemma zS304 (zv : zzV) : zzQ ((zK304 zv)) := by zzK1 zK304 zK308 (zS308 (zzF3 (zv 0) (zv 1) (zv 2))) +lemma zS300 (zv : zzV) : zzQ ((zK300 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK300 zK303 h_vr (zS303 (zzF2 (zv 1) (zv 2))) + · zzK2 zK300 zK304 h_vr (zS304 (zzF3 (r) (zv 1) (zv 2))) +lemma zS298 (zv : zzV) : zzQ ((zK298 zv)) := by zzK1 zK298 zK300 (zS300 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) +lemma zS296 (zv : zzV) : zzQ ((zK296 zv)) := by zzK1 zK296 zK298 (zS298 (zzF3 (1) (zv 0) (zv 1))) +lemma zS294 (zv : zzV) : zzQ ((zK294 zv)) := by zzK1 zK294 zK296 (zS296 (zzF2 (zv 0) (zv 1))) +lemma zS292 (zv : zzV) : zzQ ((zK292 zv)) := by zzK1 zK292 zK294 (zS294 (zzF2 (zv 0) (zv 1))) +lemma zS290 (zv : zzV) : zzQ ((zK290 zv)) := by zzK1 zK290 zK292 (zS292 (zzF2 (zv 0) (zv 1))) +lemma zS288 (zv : zzV) : zzQ ((zK288 zv)) := by + rcases h_vr : zv 0 with _ | r + · zzK2 zK288 zK289 h_vr (zS289 (zzF1 (zv 1))) + · zzK2 zK288 zK290 h_vr (zS290 (zzF2 (r) (zv 1))) +lemma zS287 (zv : zzV) : zzQ ((zK287 zv)) := by zzK1 zK287 zK288 (zS288 (zzF2 (zv 0) (zv 1))) +lemma zS353 (zv : zzV) : zzQ ((zK353 zv)) := by zzK1 zK353 zK297 (zS297 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma zS348 (zv : zzV) : zzQ ((zK348 zv)) := by zzK1 zK348 zK353 (zS353 (zzF2 (zv 0) (zv 1))) +lemma zA354 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK349 zv'))) : + zzQ ((zK354 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK354 zK348 h_vl (zS348 (zzF2 ((zv 1 + 1)) (zv 2))) + · zzK2 zK354 zK349 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) +lemma zS349 (zv : zzV) : zzQ ((zK349 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK349 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK349 zK354 (zA354 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS343 (zv : zzV) : zzQ ((zK343 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK343 zK348 h_vl (zS348 (zzF2 (1) (zv 1))) + · zzK2 zK343 zK349 h_vl (zS349 (zzF3 (l) (1) (zv 1))) +lemma zS339 (zv : zzV) : zzQ ((zK339 zv)) := by zzK1 zK339 zK343 (zS343 (zzF2 (zv 0) (zv 1))) +lemma zS335 (zv : zzV) : zzQ ((zK335 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK335 zK293 h_vl (zS293 (zzF1 (zv 1))) + · zzK2 zK335 zK339 h_vl (zS339 (zzF2 (l) (zv 1))) +lemma zS328 (zv : zzV) : zzQ ((zK328 zv)) := by zzK1 zK328 zK335 (zS335 (zzF2 (zv 0) (zv 1))) +lemma zS355 (zv : zzV) : zzQ ((zK355 zv)) := by zzK1 zK355 zK298 (zS298 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) +lemma zS350 (zv : zzV) : zzQ ((zK350 zv)) := by zzK1 zK350 zK355 (zS355 (zzF3 (zv 0) (zv 1) (zv 2))) +lemma zA356 (zv : zzV) + (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK351 zv'))) : + zzQ ((zK356 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK356 zK350 h_vl (zS350 (zzF3 ((zv 1 + 1)) (zv 2) (zv 3))) + · zzK2 zK356 zK351 h_vl (h_u (zzF4 (l) ((zv 1 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega)) +lemma zS351 (zv : zzV) : zzQ ((zK351 zv)) := by + suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK351 zv)) from h_ind (zv 0) zv rfl + intro n + refine Nat.strongRecOn n (fun n ih zv h_n => ?_) + zzK1 zK351 zK356 (zA356 (zzF4 (zv 0) (zv 1) (zv 2) (zv 3)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) +lemma zS344 (zv : zzV) : zzQ ((zK344 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK344 zK350 h_vl (zS350 (zzF3 (1) (zv 1) (zv 2))) + · zzK2 zK344 zK351 h_vl (zS351 (zzF4 (l) (1) (zv 1) (zv 2))) +lemma zS340 (zv : zzV) : zzQ ((zK340 zv)) := by zzK1 zK340 zK344 (zS344 (zzF3 (zv 0) (zv 1) (zv 2))) +lemma zS336 (zv : zzV) : zzQ ((zK336 zv)) := by + rcases h_vl : zv 0 with _ | l + · zzK2 zK336 zK294 h_vl (zS294 (zzF2 (zv 1) (zv 2))) + · zzK2 zK336 zK340 h_vl (zS340 (zzF3 (l) (zv 1) (zv 2))) +lemma zS329 (zv : zzV) : zzQ ((zK329 zv)) := by zzK1 zK329 zK336 (zS336 (zzF3 (zv 0) (zv 1) (zv 2))) +lemma step_hub_30_step1 (zv : zzV) : zzQ ((zzE pat_30_step1 zv)) := by + rcases h_vr : zv 0 with _ | r + · have h_eq : zzE pat_30_step1 zv = zK33 (fun _ => 0) := by + simp -failIfUnchanged only [evalTapePattern, pat_30_step1, zK33, evalTapeExpr]; rw [h_vr] + zzS2 + rw [h_eq]; exact zS33 (fun _ => 0) + · have h_eq : zzE pat_30_step1 zv = zK34 (zzF1 (r)) := by + simp -failIfUnchanged only [evalTapePattern, pat_30_step1, zK34, evalTapeExpr]; rw [h_vr] + zzS2 + rw [h_eq]; exact zS34 (zzF1 (r)) +lemma step_hub_66 (zv : zzV) : zzQ ((zzE zP66 zv)) := by zzK1 zP66 zK71 (zS71 (zzF1 (zv 0))) +lemma step_hub_68 (zv : zzV) : zzQ ((zzE zP68 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zP68 zK73 h_vr (zS73 (zzF1 (zv 0))) + · zzK2 zP68 zK74 h_vr (zS74 (zzF2 (zv 0) (r))) +lemma zS76 (zv : zzV) : zzQ ((zK76 zv)) := by zzK1 zK76 zP68 (step_hub_68 (zzF2 ((zv 0 + 1)) (zv 1))) +lemma step_hub_140_step1 (zv : zzV) : zzQ ((zzE pat_140_step1 zv)) := by + rcases h_vr : zv 0 with _ | r + · have h_eq : zzE pat_140_step1 zv = zK145 (zzF1 (zv 1)) := by + simp -failIfUnchanged only [evalTapePattern, pat_140_step1, zK145, evalTapeExpr]; rw [h_vr] + zzS2 + rw [h_eq]; exact zS145 (zzF1 (zv 1)) + · have h_eq : zzE pat_140_step1 zv = zK146 (zzF2 (r) (zv 1)) := by + simp -failIfUnchanged only [evalTapePattern, pat_140_step1, zK146, evalTapeExpr]; rw [h_vr] + zzS2 + rw [h_eq]; exact zS146 (zzF2 (r) (zv 1)) +lemma step_hub_321 (zv : zzV) : zzQ ((zzE zP321 zv)) := by + rcases h_vr : zv 1 with _ | r + · zzK2 zP321 zK328 h_vr (zS328 (zzF2 (zv 0) (zv 2))) + · zzK2 zP321 zK329 h_vr (zS329 (zzF3 (zv 0) (r) (zv 2))) +lemma zS331 (zv : zzV) : zzQ ((zK331 zv)) := by zzK1 zK331 zP321 (step_hub_321 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) +lemma step_hub_A3_30 (zv : zzV) (h_cond : evalVarCond zC30 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [zC30, evalVarCond] at h_cond + have h_0 : zv 0 = 0 := by omega + have h_1 : zv 1 = 0 := by omega + have h_2 : zv 2 = 0 := by omega + have h_3 : zv 3 = 0 := by omega + have h_4 : zv 4 = 1 := by omega + have h_6 : zv 6 = 0 := by omega + have h_eq : zzE pat_A3 zv = zzE pat_30_step1 (zzF1 (zv 5)) := by + simp -failIfUnchanged only [pat_A3, pat_30_step1, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_6] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact step_hub_30_step1 (zzF1 (zv 5)) +lemma step_hub_A3_140 (zv : zzV) (h_cond : evalVarCond zC140 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [zC140, evalVarCond] at h_cond + have h_0 : zv 0 = 0 := by omega + have h_1 : zv 1 = 0 := by omega + have h_2 : zv 2 = 1 := by omega + have h_4 : zv 4 = 3 := by omega + have h_5 : zv 5 = 0 := by omega + have h_eq : zzE pat_A3 zv = zzE pat_140_step1 (zzF2 (zv 3) (zv 6)) := by + simp -failIfUnchanged only [pat_A3, pat_140_step1, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_1]; rw [h_2]; rw [h_4]; rw [h_5] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact step_hub_140_step1 (zzF2 (zv 3) (zv 6)) +lemma step_hub_A3_66 (zv : zzV) (h_cond : evalVarCond zC66 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [zC66, evalVarCond] at h_cond + have h_0 : zv 0 = 1 := by omega + have h_2 : zv 2 = 0 := by omega + have h_3 : zv 3 = 0 := by omega + have h_4 : zv 4 = 0 := by omega + have h_5 : zv 5 = 0 := by omega + have h_6 : zv 6 = 0 := by omega + have h_eq : zzE pat_A3 zv = zzE zP66 (zzF1 (zv 1)) := by + simp -failIfUnchanged only [pat_A3, zP66, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact step_hub_66 (zzF1 (zv 1)) +lemma step_hub_A3_76 (zv : zzV) (h_cond : evalVarCond zC76 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [zC76, evalVarCond] at h_cond + have h_0 : zv 0 = 0 := by omega + have h_1 : zv 1 = (zv 1 - 1) + 1 := by omega + have h_2 : zv 2 = 0 := by omega + have h_3 : zv 3 = 0 := by omega + have h_4 : zv 4 = 1 := by omega + have h_5 : zv 5 = (zv 5 - 1) + 1 := by omega + have h_6 : zv 6 = 0 := by omega + have h_eq : zzE pat_A3 zv = zK76 (zzF2 ((zv 1 - 1)) ((zv 5 - 1))) := by + simp -failIfUnchanged only [pat_A3, zK76, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact zS76 (zzF2 ((zv 1 - 1)) ((zv 5 - 1))) +lemma step_hub_A3_331 (zv : zzV) (h_cond : evalVarCond zC331 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [zC331, evalVarCond] at h_cond + have h_0 : zv 0 = 0 := by omega + have h_2 : zv 2 = 0 := by omega + have h_3 : zv 3 = 0 := by omega + have h_4 : zv 4 = 1 := by omega + have h_5 : zv 5 = (zv 5 - 1) + 1 := by omega + have h_6 : zv 6 = (zv 6 - 1) + 1 := by omega + rcases h_1 : zv 1 with _ | v1 + · have h_eq : zzE pat_A3 zv = zK287 (zzF2 ((zv 5 - 1)) ((zv 6 - 1))) := by + simp -failIfUnchanged only [pat_A3, zK287, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact zS287 (zzF2 ((zv 5 - 1)) ((zv 6 - 1))) + · have h_eq : zzE pat_A3 zv = zK331 (zzF3 (v1) ((zv 5 - 1)) ((zv 6 - 1))) := by + simp -failIfUnchanged only [pat_A3, zK331, evalTapePattern, evalTapeExpr] + rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] + simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] + rw [h_eq] + exact zS331 (zzF3 (v1) ((zv 5 - 1)) ((zv 6 - 1))) +lemma step_hub_A3 (zv : zzV) (h_cond : evalVarCond cond_A3 zv) : zzQ ((zzE pat_A3 zv)) := by + simp -failIfUnchanged [cond_A3, evalVarCond] at h_cond + rcases h_cond with h_cond | h_cond + · exact step_hub_A3_30 zv h_cond + rcases h_cond with h_cond | h_cond + · exact step_hub_A3_140 zv h_cond + rcases h_cond with h_cond | h_cond + · exact step_hub_A3_66 zv h_cond + rcases h_cond with h_cond | h_cond + · exact step_hub_A3_76 zv h_cond + exact step_hub_A3_331 zv h_cond +lemma init_reaches_ps : ∃ cfg_0, ((init []) [target_tm]⊢* cfg_0) /\ IsInPatternSet ps cfg_0 := by + exact ⟨zzE pat_30_step1 (fun _ => 0), init_reaches_pat_30_step1, in_ps_30_step1 (fun _ => 0)⟩ +theorem is_cryptid_proof (_ : True := trivial) : IsCryptid target_tm := by + refine ⟨ps, by decide, init_reaches_ps, ?_⟩ + intro cfg h_in + rcases h_in with ⟨entry, h_mem, zv, rfl, h_cond⟩ + rcases h_mem with ⟨⟩ | ⟨_, h_mem⟩ + · exact step_hub_A3 zv h_cond + · nomatch h_mem +end Solution + +end Solution + +-- END EXPLORATORY DEFINITIONS AND LEMMAS + +-- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) + +set_option linter.unusedVariables false +set_option linter.unusedSimpArgs false +set_option linter.deprecated false +set_option linter.dupNamespace false +set_option linter.unreachableTactic false +set_option linter.unusedTactic false +set_option quotPrecheck false +set_option maxRecDepth 4000000 +set_option maxHeartbeats 8000000 +open Solution in +theorem is_cryptid : IsCryptid target_tm := Solution.is_cryptid_proof + +end BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE diff --git a/BusyBeaver/BB6/README.md b/BusyBeaver/BB6/README.md index 37256a0b..d6fa8ef3 100644 --- a/BusyBeaver/BB6/README.md +++ b/BusyBeaver/BB6/README.md @@ -1,6 +1,6 @@ # Busy Beaver 6 Holdouts (`BusyBeaver/BB6/`) -This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 54 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines (the [A6 nonhalting certificate](../../artifacts/a6/README.md) and 53 closed-pattern holdouts, including a Baker-free 2-adic Laurent-determinant non-halting proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`), together with 35 stacked, odometer, and transducer holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—plus 20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (89 `BB(6)` holdouts total), alongside 191 resolved `BB(6)` holdouts categorized under **[`BusyBeaver/BB6/Halt/`](./Halt/)** (32 kernel-verified halting machines, `IsHalt`) and **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)** (159 kernel-verified non-halting machines, `IsNotHalt`), resolving machines from the `bbchallenge` holdout set and `busycoq` formalizations (280 distinct `BB(6)` machines overall). Each machine module in `BusyBeaver/BB6/` below exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. +This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 55 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines (the [A6 nonhalting certificate](../../artifacts/a6/README.md), 54 closed-pattern holdouts including a Baker-free 2-adic Laurent-determinant non-halting proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---` and `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`), together with 56 stacked, odometer, transducer, and cryptid holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations, and 21 Hard holdout cryptid machines under `IsSegmentedCryptid`, `IsStackCryptid`, and `IsOdometerCryptid`) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (111 `BB(6)` holdouts total), alongside 191 resolved `BB(6)` holdouts categorized under **[`BusyBeaver/BB6/Halt/`](./Halt/)** (32 kernel-verified halting machines, `IsHalt`) and **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)** (159 kernel-verified non-halting machines, `IsNotHalt`), resolving machines from the `bbchallenge` holdout set and `busycoq` formalizations (302 distinct `BB(6)` machines overall). Each machine module in `BusyBeaver/BB6/` below exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. The A6 module exports a closed blank-tape `IsNotHalt` proof using a checked entry certificate and a universal return family; it has a separate @@ -46,6 +46,7 @@ entry certificate and a universal return family; it has a separate | `1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LF---_0RA1LA` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LFHHH_0RA1LA.lean`](./M_1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LFHHH_0RA1LA.lean) | | `1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_---1RD` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_HHH1RD.lean`](./M_1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_HHH1RD.lean) | | `1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_---0RC` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_---0RC) | [`M_1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_HHH0RC.lean`](./M_1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_HHH0RC.lean) | +| `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` | `6` | `2` | `IsCryptid` | — | [`M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean`](./M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean) | | `1RB1LE_1LB1LC_1RD0LE_---0RB_1RF1LA_0RA0RD` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki (`Cryptids`)](https://wiki.bbchallenge.org/wiki/Cryptids) | [`M_1RB1LE_1LB1LC_1RD0LE_HHH0RB_1RF1LA_0RA0RD.lean`](./M_1RB1LE_1LB1LC_1RD0LE_HHH0RB_1RF1LA_0RA0RD.lean) | | `1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_---1RC` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_---1RC) (TMBR Aug 2025) | [`M_1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_HHH1RC.lean`](./M_1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_HHH1RC.lean) | | `1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_---0RE` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_HHH0RE.lean`](./M_1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_HHH0RE.lean) | diff --git a/BusyBeaver/Defs/Odometer.lean b/BusyBeaver/Defs/Odometer.lean index ba03d1e6..8832bc1e 100644 --- a/BusyBeaver/Defs/Odometer.lean +++ b/BusyBeaver/Defs/Odometer.lean @@ -38,8 +38,12 @@ def evalOdomR {Γ Λ : Type*} [Inhabited Γ] (side : OdomSide) (q_R : Λ) (pfx_R : List Γ) (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := match side with - | .leftOdom => Cfg.headRight q_R (ListBlank.append pfx_R encOdom) w - | .rightOdom => Cfg.headLeft q_R w (ListBlank.append pfx_R encOdom) + | .leftOdom => + (⟨some q_R, ⟨(w : ListBlank Γ).head, + ListBlank.append pfx_R encOdom, (w : ListBlank Γ).tail⟩⟩ : Cfg Γ Λ) + | .rightOdom => + (⟨some q_R, ⟨(w : ListBlank Γ).head, + (w : ListBlank Γ).tail, ListBlank.append pfx_R encOdom⟩⟩ : Cfg Γ Λ) /-- Evaluate the inward-facing odometer entry configuration (head at `q_L` facing the odometer stack `encOdom` across fixed boundary prefix `pfx_L`). -/ @@ -48,8 +52,12 @@ def evalOdomL {Γ Λ : Type*} [Inhabited Γ] (side : OdomSide) (q_L : Λ) (pfx_L : List Γ) (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := match side with - | .leftOdom => Cfg.headLeft q_L encOdom (ListBlank.append pfx_L w) - | .rightOdom => Cfg.headRight q_L (ListBlank.append pfx_L w) encOdom + | .leftOdom => + (⟨some q_L, ⟨(encOdom : ListBlank Γ).head, + (encOdom : ListBlank Γ).tail, ListBlank.append pfx_L w⟩⟩ : Cfg Γ Λ) + | .rightOdom => + (⟨some q_L, ⟨(encOdom : ListBlank Γ).head, + ListBlank.append pfx_L w, (encOdom : ListBlank Γ).tail⟩⟩ : Cfg Γ Λ) /-- The blank-tape trajectory of `M` enters a closed outward-facing odometer-word hub coupled with a non-surjective multi-bit mixed-radix odometer stack (`OdomTok`, `cap`, `dec`, `drain`) supporting @@ -127,4 +135,78 @@ def HasOdometerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) +/-- Closed mixed-radix odometer-word hub system (`IsOdometerCryptid`). -/ +def IsOdometerCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (OdomTok : Type) + (side : OdomSide) + (q_R : List OdomTok → Λ) + (q_L : Λ) + (pfx_R pfx_L odomBase : List (Fin (k + 2))) + (odomWord : OdomTok → List (Fin (k + 2))) + (encOdom : List OdomTok → ListBlank (Fin (k + 2))) + (cap : List OdomTok → ℕ) + (dec : List OdomTok → List OdomTok) + (decPfx : List OdomTok → List (Fin (k + 2))) + (drain : List OdomTok → List (Fin (k + 2))) + (IsInOdomSystem : Cfg (Fin (k + 2)) Λ → Prop), + (∃ toks : List OdomTok, 2 ≤ toks.length ∧ toks.length ≤ 6 ∧ ∀ t : OdomTok, t ∈ toks) ∧ + odomBase ≠ [] ∧ + (∀ t : OdomTok, 2 ≤ (odomWord t).length) ∧ + encOdom [] = ListBlank.append odomBase default ∧ + (∀ t stk, encOdom (t :: stk) = ListBlank.append (odomWord t) (encOdom stk)) ∧ + (∃ t : ListBlank (Fin (k + 2)), ∀ stk : List OdomTok, encOdom stk ≠ t) ∧ + cap [] = 0 ∧ + (∃ (t_inc t_even t_div : OdomTok) (b : ℕ) (blk_inc blk_div : List (Fin (k + 2))), + 2 ≤ b ∧ 2 ≤ blk_inc.length ∧ 2 ≤ blk_div.length ∧ + (∀ stk, cap (t_inc :: stk) = 2 * cap stk + 1) ∧ + (∀ stk, cap (t_even :: stk) = 2 * cap stk) ∧ + (∀ stk, cap (t_div :: stk) = cap stk / b) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_inc w)) + (evalOdomR side (q_R (t_inc :: stk)) pfx_R (encOdom (t_inc :: stk)) w)) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_div w)) + (evalOdomR side (q_R (t_div :: stk)) pfx_R (encOdom (t_div :: stk)) w))) ∧ + (∀ stk, (dec stk).length = stk.length) ∧ + (∀ stk, cap stk ≥ 1 → cap (dec stk) = cap stk - 1) ∧ + (∀ stk w, cap stk ≥ 1 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R (dec stk)) pfx_R (encOdom (dec stk)) + (ListBlank.append (decPfx stk) w))) ∧ + (∀ stk, cap stk = 0 → drain stk ≠ []) ∧ + (∀ stk w, cap stk = 0 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R []) pfx_R (encOdom []) (ListBlank.append (drain stk) w))) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.cons (0 : Fin (k + 2)) w)) + (evalOdomL side q_L pfx_L (encOdom stk) (ListBlank.cons (1 : Fin (k + 2)) w))) ∧ + (∀ stk w, + w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0)) → + (∃ t w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomR side (q_R (t :: stk)) pfx_R (encOdom (t :: stk)) w')) ∨ + (∃ w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomL side q_L pfx_L (encOdom stk) w')) ∨ + (∃ cfg', + ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (step M cfg').isNone)) ∧ + (∀ cfg, IsInOdomSystem cfg ↔ + ∃ stk w, cfg = evalOdomR side (q_R stk) pfx_R (encOdom stk) w) ∧ + (∃ (stk₀ : List OdomTok) (w₀ : ListBlank (Fin (k + 2))), + ReachesPlus M (init []) (evalOdomR side (q_R stk₀) pfx_R (encOdom stk₀) w₀) ∧ + 2 ≤ stk₀.length ∧ 1 ≤ cap stk₀) ∧ + (∀ stk w, + w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0)) → + ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) + end BusyBeaver diff --git a/BusyBeaver/Defs/Segmented.lean b/BusyBeaver/Defs/Segmented.lean index e0e97556..d43dae97 100644 --- a/BusyBeaver/Defs/Segmented.lean +++ b/BusyBeaver/Defs/Segmented.lean @@ -24,15 +24,17 @@ namespace BusyBeaver open Relation Turing +universe u v + /-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ -inductive SegRegionKind (Γ : Type*) where +inductive SegRegionKind (Γ : Type u) where | reg (blk : List Γ) (val : ℕ) | wordRun (frames : List (List Γ × ℕ)) | finWord (words : List (List Γ)) | gadget (w : List Γ) /-- Evaluates a single `SegRegionKind Γ` into its `List Γ` bit-segment. -/ -def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ +def evalSegRegion {Γ : Type u} : SegRegionKind Γ → List Γ | .reg blk v => blk ^ v | .wordRun [] => [] | .wordRun ((w, m) :: rest) => (w ^ m) ++ evalSegRegion (.wordRun rest) @@ -41,7 +43,7 @@ def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ | .gadget w => w /-- Evaluates a `≤ 3`-region segmented half-tape `List (SegRegionKind Γ)` onto `default`. -/ -def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ +def evalSegmentedHalf {Γ : Type u} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ | [] => default | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) @@ -50,20 +52,20 @@ def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → valid state encodes, i.e. the image has empty interior in the prefix topology. A bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ -def IsNowhereDenseFamily {Γ S : Type*} [Inhabited Γ] +def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad /-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ -def IsNowhereDenseHalf {Γ S : Type*} [Inhabited Γ] +def IsNowhereDenseHalf {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) /-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view prefix). -/ -def IsSegmentedCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] +def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] (M : Machine (Fin (k + 2)) Λ) : Prop := ∃ (SegState : Type) (Mode : Type) diff --git a/BusyBeaver/Defs/Stack.lean b/BusyBeaver/Defs/Stack.lean index 0ab9304d..04b059c7 100644 --- a/BusyBeaver/Defs/Stack.lean +++ b/BusyBeaver/Defs/Stack.lean @@ -254,4 +254,43 @@ def HasStackReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] (∀ cfg, IsInStackSystem cfg → ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) +/-- Unifying 2nd-Order Digit-Stack Schema (`IsStackCryptid`). -/ +def IsStackCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (StackMode : Type) + (dSym sSym : Fin (k + 2)) + (encLeft encRight : List (StackTuple (k + 2)) → ListBlank (Fin (k + 2))) + (evalStackCfg : + StackMode → List (StackTuple (k + 2)) → List (StackTuple (k + 2)) → Cfg (Fin (k + 2)) Λ) + (IsInStackSystem : Cfg (Fin (k + 2)) Λ → Prop), + IsValidStackPolarity dSym sSym ∧ + encLeft [] = default ∧ + encRight [] = default ∧ + (∀ a b L, (encLeft ((a, b) :: L)).head = dSym) ∧ + (∀ d b R, (encRight ((d, b) :: R)).head = dSym) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ L : List (StackTuple (k + 2)), encLeft L ≠ t) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ R : List (StackTuple (k + 2)), encRight R ≠ t) ∧ + (∃ strideL offsetL sepL maxSepL strideR offsetR sepR maxSepR : ℕ, + strideL > 0 ∧ offsetL > 0 ∧ sepL > 0 ∧ 1 ≤ maxSepL ∧ maxSepL ≤ 4 ∧ + strideR > 0 ∧ offsetR > 0 ∧ sepR > 0 ∧ 1 ≤ maxSepR ∧ maxSepR ≤ 4 ∧ + (∀ a b L, encLeft ((a, b) :: L) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideL * a + offsetL)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepL maxSepL b)) + (encLeft L))) ∧ + (∀ d b R, encRight ((d, b) :: R) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideR * d + offsetR)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepR maxSepR b)) + (encRight R)))) ∧ + (∃ modes : List StackMode, modes.length ≤ 6 ∧ ∀ m : StackMode, m ∈ modes) ∧ + IsValidStackModes encLeft encRight evalStackCfg ∧ + (∀ cfg, IsInStackSystem cfg ↔ ∃ m L R, cfg = evalStackCfg m L R) ∧ + (∀ m L R, IsInStackSystem (evalStackCfg m L R)) ∧ + (∃ cfg₀, ReachesPlus M (init []) cfg₀ ∧ IsInStackSystem cfg₀) ∧ + (∀ cfg, IsInStackSystem cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) + end BusyBeaver diff --git a/BusyBeaver/Defs/WordRun.lean b/BusyBeaver/Defs/WordRun.lean index 71895b9c..d33d7120 100644 --- a/BusyBeaver/Defs/WordRun.lean +++ b/BusyBeaver/Defs/WordRun.lean @@ -37,7 +37,8 @@ def encRegsAux {Γ : Type*} [Inhabited Γ] : (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ListBlank Γ → ListBlank Γ | 0, _, _, tail => tail | m + 1, rw, r, tail => - ListBlank.append ((rw 0) ^ (r 0)) (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) + ListBlank.append ((rw 0) ^ (r 0)) + (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) /-- Encodes the bottom accumulator registers + `base` of a `WordStackSpec`. -/ def encRegs {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} @@ -77,10 +78,13 @@ def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m | 0, _, _ => 0 | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) +section +universe u + /-- Prefix length of a `HalfTapeView`. -/ -def viewPrefixLen {Γ : Type*} : HalfTapeView Γ → ℕ - | .id p => p.length - | .tail p => p.length +def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := + v.casesOn (fun p => p.length) (fun p => p.length) +end /-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ structure WordSysState (Mode TokL TokR : Type*) (numRegsL numRegsR : ℕ) where @@ -143,7 +147,8 @@ def DrainsTop {Γ Tok : Type*} {numRegs : ℕ} (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := ¬ PreservesOrGrows spec xs xs' -/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is completely popped. -/ +/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is + completely popped. -/ def PopsTop {Tok : Type*} (xs xs' : List (Tok × ℕ)) : Prop := ∃ f, xs = f :: xs' diff --git a/BusyBeaver/README.md b/BusyBeaver/README.md index 33e50a15..2b69181d 100644 --- a/BusyBeaver/README.md +++ b/BusyBeaver/README.md @@ -2,7 +2,7 @@ This library contains formal Lean 4 specifications and kernel-verified behavioral proofs for Busy Beaver 6 (`BB(6)`) and Busy Beaver (3, 3) (`BB(3, 3)`) holdouts, connected to `ConjectureMachines.Machine` via [`BusyBeaver/Bridge.lean`](./Bridge.lean): -- **[`BusyBeaver/BB6/`](./BB6/README.md)** — 280 `BB(6)` (6-state, 2-symbol) Turing machines: 54 holdouts in `BB6/` (the [A6 nonhalting certificate](../artifacts/a6/README.md) and 53 holdouts with certified closed `TapePatternSet` invariants `IsClosedPatternSet`, `HasCollatzReduction` and Collatz-like accelerations `IsValidAcceleration`, including a self-contained, Baker-free 2-adic Laurent-determinant `IsNotHalt` proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`), plus 35 stacked, odometer, and transducer holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—and 20 open acceleration problems under `IsValidAcceleration`, 13 of which additionally carry higher-level Poincaré/contraction accelerations `highLevelNext`) in **[`BusyBeaver/BB6/Accelerations/`](./BB6/Accelerations/README.md)**, together with machine-level halting equivalences ([`Equivalences.lean`](./BB6/Equivalences.lean)), hardness classification ([`Hardness.lean`](./BB6/Hardness.lean)), and formal hardness evidence ([`HardnessEvidence.lean`](./BB6/HardnessEvidence.lean)), alongside 191 resolved holdouts in **[`BusyBeaver/BB6/Halt/`](./BB6/Halt/)** (32 `IsHalt` proofs) and **[`BusyBeaver/BB6/NonHalt/`](./BB6/NonHalt/)** (159 `IsNotHalt` proofs) reproducing community and `busycoq` results. +- **[`BusyBeaver/BB6/`](./BB6/README.md)** — 302 `BB(6)` (6-state, 2-symbol) Turing machines: 55 holdouts in `BB6/` (the [A6 nonhalting certificate](../artifacts/a6/README.md) and 54 holdouts with certified closed `TapePatternSet` invariants `IsClosedPatternSet`, `HasCollatzReduction` and Collatz-like accelerations `IsValidAcceleration`, including a self-contained, Baker-free 2-adic Laurent-determinant `IsNotHalt` proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`), plus 56 stacked, odometer, transducer, and cryptid holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—20 open acceleration problems under `IsValidAcceleration`, 13 of which additionally carry higher-level Poincaré/contraction accelerations `highLevelNext`, and 21 Hard holdout cryptid machines under `IsSegmentedCryptid`, `IsStackCryptid`, and `IsOdometerCryptid`) in **[`BusyBeaver/BB6/Accelerations/`](./BB6/Accelerations/README.md)**, together with machine-level halting equivalences ([`Equivalences.lean`](./BB6/Equivalences.lean)), hardness classification ([`Hardness.lean`](./BB6/Hardness.lean)), and formal hardness evidence ([`HardnessEvidence.lean`](./BB6/HardnessEvidence.lean)), alongside 191 resolved holdouts in **[`BusyBeaver/BB6/Halt/`](./BB6/Halt/)** (32 `IsHalt` proofs) and **[`BusyBeaver/BB6/NonHalt/`](./BB6/NonHalt/)** (159 `IsNotHalt` proofs) reproducing community and `busycoq` results. - **[`BusyBeaver/BB33/`](./BB33/README.md)** — All 6 remaining unsolved `BB(3, 3)` (3-state, 3-symbol) holdout Turing machines (4 equivalence classes: *Bigfoot* (holdout #829), the *Wily Coyote* pair (holdouts #531 & #532), the holdout #758 / #153 pair (probvious champion), and holdout #397), with certified Collatz-like (`HasCollatzReduction`) or stacked Collatz-like (`HasStackedCollatzReduction`) reductions and exact halting equivalences (`IsValidAcceleration`). ## Cryptids, Collatz-like, and Stacked Collatz Reductions diff --git a/BusyBeaver/Stack.lean b/BusyBeaver/Stack.lean new file mode 100644 index 00000000..b3b4e1c2 --- /dev/null +++ b/BusyBeaver/Stack.lean @@ -0,0 +1,452 @@ +module + +public import BusyBeaver.Basic +import Mathlib.Tactic.Ring + +@[expose] public section + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.PairStack + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.unusedVariables false +set_option linter.unusedSimpArgs false + + +-- ============================================================================ +-- Section 1: Tape & List Algebra Helpers +-- ============================================================================ + +variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + +theorem pow_zero_list (u : List (Fin 2)) : u ^ (0 : Nat) = [] := rfl +theorem pow_succ_list (u : List (Fin 2)) (n : Nat) : u ^ (n + 1) = u ++ u ^ n := rfl +theorem nil_append_list (l : List (Fin 2)) : ([] : List (Fin 2)) ++ l = l := rfl +theorem cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : (x :: xs) ++ ys = x :: (xs ++ ys) := rfl +theorem append_nil_list (l : List (Fin 2)) : l ++ [] = l := List.append_nil l + +attribute [scoped simp] + pow_zero_list + pow_succ_list + nil_append_list + cons_append_list + append_nil_list + listblank_append_nil + listblank_append_cons + zero_cons_default + ListBlank.head_default + ListBlank.tail_default + +omit [Inhabited Γ] in +theorem list_pow_add (l : List Γ) (n m : Nat) : l^(n + m) = l^n ++ l^m := + BusyBeaver.list_pow_add l n m + +lemma listblank_append_right_assoc (l₁ l₂ : List Γ) (s : ListBlank Γ) : + (l₁ ++ l₂) +> s = l₁ +> (l₂ +> s) := by + induction l₁ with + | nil => rfl + | cons x xs ih => + simp only [List.cons_append, ListBlank.append, ih] + +lemma listblank_eq_one_cons_tail {Z : ListBlank (Fin 2)} (hZ : Z.head = 1) : + Z = (1 : Fin 2) >> Z.tail := by + rw [← hZ, Turing.ListBlank.cons_head_tail] + +@[simp] lemma zeros_append_default (n : ℕ) : + (([0] : List (Fin 2)) ^ n) +> (default : ListBlank (Fin 2)) = default := by + induction n with + | zero => rfl + | succ k ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, zero_cons_default] + +-- ============================================================================ +-- Section 2: Universal Stack Combinators +-- ============================================================================ + +/-- Increment the primary coordinate of the top stack element (or push `(0, 0)` if empty). -/ +def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: L => (a + 1, b) :: L + +/-- Increment the primary coordinate of the top stack element `n` times. -/ +def bumpN : ℕ → List (ℕ × ℕ) → List (ℕ × ℕ) + | 0, L => L + | n + 1, L => bumpHead (bumpN n L) + +/-- Ensure a stack is non-empty by appending `(0, 0)` if empty. -/ +def ensureNonEmpty : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | p :: R => p :: R + +@[simp] theorem bumpN_zero (L : List (ℕ × ℕ)) : bumpN 0 L = L := rfl +@[simp] theorem bumpN_succ (n : ℕ) (L : List (ℕ × ℕ)) : bumpN (n + 1) L = bumpHead (bumpN n L) := rfl + +theorem bumpHead_ne_nil (L : List (ℕ × ℕ)) : bumpHead L ≠ [] := by + rcases L with _ | ⟨⟨a, b⟩, L'⟩ <;> simp [bumpHead] + +theorem bumpN_succ_ne_nil (n : ℕ) (L : List (ℕ × ℕ)) : bumpN (n + 1) L ≠ [] := by + simp only [bumpN_succ]; exact bumpHead_ne_nil (bumpN n L) + +theorem ensureNonEmpty_ne_nil (R : List (ℕ × ℕ)) : ensureNonEmpty R ≠ [] := by + rcases R with _ | ⟨p, R'⟩ <;> simp [ensureNonEmpty] + +-- ============================================================================ +-- Section 3: Parametric Stack Encodings +-- ============================================================================ + +/-- Generic parametric left stack encoding: + `encLeft ((a, b) :: L) = encLeft L <+ (sSym ^ (sep + b % maxSep)) <+ (dSym ^ (stride * a + offset))`. -/ +def encLeftParam (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : + List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (a, b) :: L => + (encLeftParam dSym sSym stride offset sep maxSep L <+ + (([sSym] : List (Fin 2)) ^ (sep + b % maxSep))) <+ + (([dSym] : List (Fin 2)) ^ (stride * a + offset)) + +/-- Generic parametric right stack encoding: + `encRight ((d, b) :: R) = (dSym ^ (stride * d + offset)) +> ((sSym ^ (sep + b % maxSep)) +> encRight R)`. -/ +def encRightParam (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : + List (ℕ × ℕ) → ListBlank (Fin 2) + | [] => default + | (d, b) :: R => + (([dSym] : List (Fin 2)) ^ (stride * d + offset)) +> + ((([sSym] : List (Fin 2)) ^ (sep + b % maxSep)) +> + encRightParam dSym sSym stride offset sep maxSep R) + +@[simp] theorem encLeftParam_nil (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : + encLeftParam dSym sSym stride offset sep maxSep [] = default := rfl + +@[simp] theorem encRightParam_nil (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : + encRightParam dSym sSym stride offset sep maxSep [] = default := rfl + +@[simp] theorem encLeftParam_cons (dSym sSym : Fin 2) (stride offset sep maxSep a b : ℕ) + (L : List (ℕ × ℕ)) : + encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L) = + (encLeftParam dSym sSym stride offset sep maxSep L <+ + (([sSym] : List (Fin 2)) ^ (sep + b % maxSep))) <+ + (([dSym] : List (Fin 2)) ^ (stride * a + offset)) := rfl + +@[simp] theorem encRightParam_cons (dSym sSym : Fin 2) (stride offset sep maxSep d b : ℕ) + (R : List (ℕ × ℕ)) : + encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R) = + (([dSym] : List (Fin 2)) ^ (stride * d + offset)) +> + ((([sSym] : List (Fin 2)) ^ (sep + b % maxSep)) +> + encRightParam dSym sSym stride offset sep maxSep R) := rfl + +-- ============================================================================ +-- Section 4: Head & Successor Theorems +-- ============================================================================ + +theorem encLeftParam_head (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (h_offset : offset > 0) (a b : ℕ) (L : List (ℕ × ℕ)) : + (encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L)).head = dSym := by + obtain ⟨off', rfl⟩ := Nat.exists_eq_succ_of_ne_zero (ne_of_gt h_offset) + rw [encLeftParam_cons, show stride * a + (off' + 1) = (stride * a + off') + 1 by omega, + pow_succ_list, cons_append_list] + simp only [listblank_append_cons, Turing.ListBlank.head_cons] + +theorem encRightParam_head (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (h_offset : offset > 0) (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R)).head = dSym := by + obtain ⟨off', rfl⟩ := Nat.exists_eq_succ_of_ne_zero (ne_of_gt h_offset) + rw [encRightParam_cons, show stride * d + (off' + 1) = (stride * d + off') + 1 by omega, + pow_succ_list, cons_append_list] + simp only [listblank_append_cons, Turing.ListBlank.head_cons] + +theorem encLeftParam_succ (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeftParam dSym sSym stride offset sep maxSep ((a + 1, b) :: L) = + (([dSym] : List (Fin 2)) ^ stride) +> + encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L) := by + simp only [encLeftParam_cons] + rw [show stride * (a + 1) + offset = stride + (stride * a + offset) by ring, + list_pow_add, listblank_append_right_assoc] + +theorem encRightParam_succ (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (d b : ℕ) (R : List (ℕ × ℕ)) : + encRightParam dSym sSym stride offset sep maxSep ((d + 1, b) :: R) = + (([dSym] : List (Fin 2)) ^ stride) +> + encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R) := by + simp only [encRightParam_cons] + rw [show stride * (d + 1) + offset = stride + (stride * d + offset) by ring, + list_pow_add, listblank_append_right_assoc] + +theorem encLeftParam_cons_dSym (dSym : Fin 2) (sep maxSep : ℕ) + (L : List (ℕ × ℕ)) : + dSym >> encLeftParam dSym 0 1 1 sep maxSep L = + encLeftParam dSym 0 1 1 sep maxSep (bumpHead L) := by + rcases L with _ | ⟨⟨a, b⟩, L'⟩ + · simp [bumpHead, encLeftParam, zeros_append_default] + · have h := encLeftParam_succ dSym 0 1 1 sep maxSep a b L' + simp only [show (([dSym] : List (Fin 2)) ^ 1) = [dSym] by rfl, + listblank_append_cons, listblank_append_nil] at h + exact h.symm + +theorem encRightParam_cons_dSym (dSym : Fin 2) (sep maxSep : ℕ) + (R : List (ℕ × ℕ)) : + dSym >> encRightParam dSym 0 1 1 sep maxSep R = + encRightParam dSym 0 1 1 sep maxSep (bumpHead R) := by + rcases R with _ | ⟨⟨d, b⟩, R'⟩ + · simp [bumpHead, encRightParam, zeros_append_default] + · have h := encRightParam_succ dSym 0 1 1 sep maxSep d b R' + simp only [show (([dSym] : List (Fin 2)) ^ 1) = [dSym] by rfl, + listblank_append_cons, listblank_append_nil] at h + exact h.symm + +theorem encLeftParam_bumpN (dSym : Fin 2) (sep maxSep : ℕ) + (n : ℕ) (L : List (ℕ × ℕ)) : + (([dSym] : List (Fin 2)) ^ n) +> encLeftParam dSym 0 1 1 sep maxSep L = + encLeftParam dSym 0 1 1 sep maxSep (bumpN n L) := by + induction n with + | zero => rfl + | succ k ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, + listblank_append_cons, ih, bumpN, encLeftParam_cons_dSym] + +theorem encRightParam_bumpN (dSym : Fin 2) (sep maxSep : ℕ) + (n : ℕ) (R : List (ℕ × ℕ)) : + (([dSym] : List (Fin 2)) ^ n) +> encRightParam dSym 0 1 1 sep maxSep R = + encRightParam dSym 0 1 1 sep maxSep (bumpN n R) := by + induction n with + | zero => rfl + | succ k ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, + listblank_append_cons, ih, bumpN, encRightParam_cons_dSym] + +-- ============================================================================ +-- Section 5: Modulo & Canonical Shorthands +-- ============================================================================ + +lemma mod2_cases (b : ℕ) : b % 2 = 0 ∨ b % 2 = 1 := by omega +lemma mod3_cases (b : ℕ) : b % 3 = 0 ∨ b % 3 = 1 ∨ b % 3 = 2 := by omega +lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega + +theorem encLeftParam_mod (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L) = + encLeftParam dSym sSym stride offset sep maxSep ((a, b % maxSep) :: L) := by + simp only [encLeftParam_cons, Nat.mod_mod] + +theorem encRightParam_mod (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (d b : ℕ) (R : List (ℕ × ℕ)) : + encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R) = + encRightParam dSym sSym stride offset sep maxSep ((d, b % maxSep) :: R) := by + simp only [encRightParam_cons, Nat.mod_mod] + +-- ============================================================================ +-- Section 6: Normalization & AllSep Predicates +-- ============================================================================ + +/-- Normalize a stack by reducing second coordinates modulo `maxSep`. -/ +def normStack (maxSep : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) := + List.map (fun p => (p.1, p.2 % maxSep)) + +/-- Predicate: every element's secondary coordinate is strictly bounded by `maxSep`. -/ +def AllSep (maxSep : ℕ) (L : List (ℕ × ℕ)) : Prop := + ∀ p ∈ L, p.2 < maxSep + +theorem encLeftParam_norm (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (L : List (ℕ × ℕ)) : + encLeftParam dSym sSym stride offset sep maxSep (normStack maxSep L) = + encLeftParam dSym sSym stride offset sep maxSep L := by + induction L with + | nil => rfl + | cons p L' ih => + rcases p with ⟨a, b⟩ + change encLeftParam dSym sSym stride offset sep maxSep ((a, b % maxSep) :: normStack maxSep L') = + encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L') + simp only [encLeftParam_cons, Nat.mod_mod, ih] + +theorem encRightParam_norm (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) + (R : List (ℕ × ℕ)) : + encRightParam dSym sSym stride offset sep maxSep (normStack maxSep R) = + encRightParam dSym sSym stride offset sep maxSep R := by + induction R with + | nil => rfl + | cons p R' ih => + rcases p with ⟨d, b⟩ + change encRightParam dSym sSym stride offset sep maxSep ((d, b % maxSep) :: normStack maxSep R') = + encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R') + simp only [encRightParam_cons, Nat.mod_mod, ih] + +theorem allSep_normStack (maxSep : ℕ) (h_pos : maxSep > 0) (L : List (ℕ × ℕ)) : + AllSep maxSep (normStack maxSep L) := by + intro p hp + rcases List.mem_map.mp hp with ⟨q, _, rfl⟩ + exact Nat.mod_lt q.2 h_pos + +-- ============================================================================ +-- Section 7: View Combinators +-- ============================================================================ + +theorem applyView_id_nil (s : ListBlank Γ) : + applyView (.id []) s = s := + rfl + +theorem applyView_id_cons (x : Γ) (xs : List Γ) (s : ListBlank Γ) : + applyView (.id (x :: xs)) s = (x :: xs) +> s := + rfl + +theorem applyView_tail_nil (s : ListBlank Γ) : + applyView (.tail []) s = s.tail := + rfl + +theorem applyView_tail_cons (x : Γ) (xs : List Γ) (s : ListBlank Γ) : + applyView (.tail (x :: xs)) s = (x :: xs) +> s.tail := + rfl + +theorem applyView_tail_one (enc : List (ℕ × ℕ) → ListBlank (Fin 2)) + (h_head : ∀ d b R, (enc ((d, b) :: R)).head = 1) + (h_nil : applyView (.tail [1]) (enc []) = enc (ensureNonEmpty [])) + (R : List (ℕ × ℕ)) : + applyView (.tail [1]) (enc R) = enc (ensureNonEmpty R) := by + rcases R with _ | ⟨⟨d, b⟩, R'⟩ + · exact h_nil + · simp only [applyView, listblank_append_cons, listblank_append_nil, ensureNonEmpty] + exact (listblank_eq_one_cons_tail (h_head d b R')).symm + +theorem applyView_tail_zero_one (enc : List (ℕ × ℕ) → ListBlank (Fin 2)) + (h_head : ∀ d b R, (enc ((d, b) :: R)).head = 1) + (h_nil : applyView (.tail [0, 1]) (enc []) = (0 : Fin 2) >> enc (ensureNonEmpty [])) + (R : List (ℕ × ℕ)) : + applyView (.tail [0, 1]) (enc R) = (0 : Fin 2) >> enc (ensureNonEmpty R) := by + rcases R with _ | ⟨⟨d, b⟩, R'⟩ + · exact h_nil + · simp only [applyView, listblank_append_cons, listblank_append_nil, ensureNonEmpty] + exact congrArg (ListBlank.cons 0) (listblank_eq_one_cons_tail (h_head d b R')).symm + +theorem applyView_tail_one_one (enc : List (ℕ × ℕ) → ListBlank (Fin 2)) + (h_head : ∀ d b R, (enc ((d, b) :: R)).head = 1) + (h_nil : applyView (.tail [1, 1]) (enc []) = (1 : Fin 2) >> enc (ensureNonEmpty [])) + (R : List (ℕ × ℕ)) : + applyView (.tail [1, 1]) (enc R) = (1 : Fin 2) >> enc (ensureNonEmpty R) := by + rcases R with _ | ⟨⟨d, b⟩, R'⟩ + · exact h_nil + · simp only [applyView, listblank_append_cons, listblank_append_nil, ensureNonEmpty] + exact congrArg (ListBlank.cons 1) (listblank_eq_one_cons_tail (h_head d b R')).symm + +-- ============================================================================ +-- Section 8: Block Encoding Audit Helper +-- ============================================================================ + +theorem blockEncodingParam + (strideL offsetL sepL maxSepL strideR offsetR sepR maxSepR : ℕ) + (h_sL : strideL > 0) (h_oL : offsetL > 0) (h_sepL : sepL > 0) + (h_m1L : 1 ≤ maxSepL) (h_m2L : maxSepL ≤ 4) + (h_sR : strideR > 0) (h_oR : offsetR > 0) (h_sepR : sepR > 0) + (h_m1R : 1 ≤ maxSepR) (h_m2R : maxSepR ≤ 4) + (dSym sSym : Fin 2) : + ∃ strideL' offsetL' sepL' maxSepL' strideR' offsetR' sepR' maxSepR' : ℕ, + strideL' > 0 ∧ offsetL' > 0 ∧ sepL' > 0 ∧ 1 ≤ maxSepL' ∧ maxSepL' ≤ 4 ∧ + strideR' > 0 ∧ offsetR' > 0 ∧ sepR' > 0 ∧ 1 ≤ maxSepR' ∧ maxSepR' ≤ 4 ∧ + (∀ a (b : StackTuple 1) L, encLeftParam dSym sSym strideL offsetL sepL maxSepL ((a, b) :: L) = + (encLeftParam dSym sSym strideL offsetL sepL maxSepL L <+ + (([sSym] : List (Fin 2)) ^ (stackSepLen sepL' maxSepL' b))) <+ + (([dSym] : List (Fin 2)) ^ (strideL' * a + offsetL'))) ∧ + (∀ d (b : StackTuple 1) R, encRightParam dSym sSym strideR offsetR sepR maxSepR ((d, b) :: R) = + (([dSym] : List (Fin 2)) ^ (strideR' * d + offsetR')) +> + ((([sSym] : List (Fin 2)) ^ (stackSepLen sepR' maxSepR' b)) +> + encRightParam dSym sSym strideR offsetR sepR maxSepR R)) := + ⟨strideL, offsetL, sepL, maxSepL, strideR, offsetR, sepR, maxSepR, + h_sL, h_oL, h_sepL, h_m1L, h_m2L, + h_sR, h_oR, h_sepR, h_m1R, h_m2R, + fun a b L => rfl, fun d b R => rfl⟩ + +-- ============================================================================ +-- Section 9: 1-Digit Stack Lift Infrastructure +-- ============================================================================ + +/-- Lift a 1-digit stack `List ℕ` to a 2-digit stack `List (ℕ × ℕ)` by appending `0` second components. -/ +def liftPairList : List ℕ → List (ℕ × ℕ) + | [] => [] + | x :: xs => (x, 0) :: liftPairList xs + +@[simp] theorem map_fst_liftPairList : ∀ L1 : List ℕ, (liftPairList L1).map Prod.fst = L1 + | [] => rfl + | _ :: xs => congrArg (_ :: ·) (map_fst_liftPairList xs) + +/-- Canonical proposition package for 1-digit stack cryptids on 2-symbol machines (`Fin 2`). -/ +def OneDigitStackCryptidProp {Λ : Type*} [Inhabited Λ] + (target_tm : Machine (Fin 2) Λ) + (StackMode : Type) + (encLeft1 encRight1 : List ℕ → ListBlank (Fin 2)) + (evalStackCfg1 : StackMode → List ℕ → List ℕ → Cfg (Fin 2) Λ) + (IsInStackSystem1 : Cfg (Fin 2) Λ → Prop) : Prop := + encLeft1 [] = default ∧ + encRight1 [] = default ∧ + (∀ a L, (encLeft1 (a :: L)).head = (1 : Fin 2)) ∧ + (∀ d R, (encRight1 (d :: R)).head = (1 : Fin 2)) ∧ + (∃ t : ListBlank (Fin 2), t.head = (1 : Fin 2) ∧ ∀ L : List ℕ, encLeft1 L ≠ t) ∧ + (∃ t : ListBlank (Fin 2), t.head = (1 : Fin 2) ∧ ∀ R : List ℕ, encRight1 R ≠ t) ∧ + (∃ strideL offsetL sepL strideR offsetR sepR : ℕ, + strideL > 0 ∧ offsetL > 0 ∧ sepL > 0 ∧ + strideR > 0 ∧ offsetR > 0 ∧ sepR > 0 ∧ + (∀ a L, encLeft1 (a :: L) = (encLeft1 L <+ (([0] : List (Fin 2)) ^ sepL)) <+ + (([1] : List (Fin 2)) ^ (strideL * a + offsetL))) ∧ + (∀ d R, encRight1 (d :: R) = (([1] : List (Fin 2)) ^ (strideR * d + offsetR)) +> + ((([0] : List (Fin 2)) ^ sepR) +> encRight1 R))) ∧ + (∃ modes : List StackMode, modes.length ≤ 6 ∧ ∀ m : StackMode, m ∈ modes) ∧ + IsValidStackModes encLeft1 encRight1 evalStackCfg1 ∧ + (∀ cfg, IsInStackSystem1 cfg ↔ ∃ m L R, cfg = evalStackCfg1 m L R) ∧ + (∀ m L R, IsInStackSystem1 (evalStackCfg1 m L R)) ∧ + (∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem1 cfg₀) ∧ + (∀ cfg, IsInStackSystem1 cfg → + ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ + (IsInStackSystem1 cfg' ∨ (step target_tm cfg').isNone)) + +/-- Universal lift theorem from 1-digit stack cryptid to 2-digit `IsStackCryptid`. -/ +theorem lift_one_digit_prop {Λ : Type*} [Inhabited Λ] + (target_tm : Machine (Fin 2) Λ) + (StackMode : Type) + (encLeft1 encRight1 : List ℕ → ListBlank (Fin 2)) + (evalStackCfg1 : StackMode → List ℕ → List ℕ → Cfg (Fin 2) Λ) + (IsInStackSystem1 : Cfg (Fin 2) Λ → Prop) + (h : OneDigitStackCryptidProp target_tm StackMode encLeft1 encRight1 evalStackCfg1 IsInStackSystem1) : + IsStackCryptid target_tm := by + refine ⟨StackMode, 1, 0, + fun (L : List (ℕ × ℕ)) => encLeft1 (L.map Prod.fst), + fun (R : List (ℕ × ℕ)) => encRight1 (R.map Prod.fst), + fun (m : StackMode) (L R : List (ℕ × ℕ)) => evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), + fun (cfg : Cfg (Fin 2) Λ) => ∃ (m : StackMode) (L R : List (ℕ × ℕ)), cfg = evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), + ?_⟩ + rcases h with ⟨hnilL, hnilR, hheadL, hheadR, ⟨tL, htL, hnsL⟩, ⟨tR, htR, hnsR⟩, + ⟨sL, oL, sepL, sR, oR, sepR, hsL, hoL, hsepL, hsR, hoR, hsepR, hblkL, hblkR⟩, + hmodes, hvalid1, hiff1, _, ⟨cfg₀, hinit0, hsys0⟩, hclosed1⟩ + refine ⟨Or.inl ⟨rfl, rfl⟩, hnilL, hnilR, + fun a _ L => hheadL a (L.map Prod.fst), + fun d _ R => hheadR d (R.map Prod.fst), + ⟨tL, htL, fun L => hnsL (L.map Prod.fst)⟩, + ⟨tR, htR, fun R => hnsR (R.map Prod.fst)⟩, + ⟨sL, oL, sepL, 1, sR, oR, sepR, 1, + hsL, hoL, hsepL, le_refl 1, by decide, + hsR, hoR, hsepR, le_refl 1, by decide, + fun a b L => by simpa [Nat.mod_one] using hblkL a (L.map Prod.fst), + fun d b R => by simpa [Nat.mod_one] using hblkR d (R.map Prod.fst)⟩, + hmodes, + fun m => ?_, + fun _ => Iff.rfl, + fun m L R => ⟨m, L, R, rfl⟩, + ?_, + ?_⟩ + · rcases hvalid1 m with ⟨q, vL, vR, hl, hr, h1 | h2 | h3⟩ + · exact ⟨q, vL, vR, hl, hr, Or.inl (fun L R => h1 (L.map Prod.fst) (R.map Prod.fst))⟩ + · exact ⟨q, vL, vR, hl, hr, Or.inr (Or.inl (fun L R => h2 (L.map Prod.fst) (R.map Prod.fst)))⟩ + · exact ⟨q, vL, vR, hl, hr, Or.inr (Or.inr (fun L R => h3 (L.map Prod.fst) (R.map Prod.fst)))⟩ + · rcases (hiff1 cfg₀).mp hsys0 with ⟨m, L1, R1, hcfg0⟩ + refine ⟨cfg₀, hinit0, m, liftPairList L1, liftPairList R1, ?_⟩ + try dsimp + rw [map_fst_liftPairList, map_fst_liftPairList] + exact hcfg0 + · intro cfg ⟨m, L, R, hcfg⟩ + have hsys1 : IsInStackSystem1 cfg := (hiff1 cfg).mpr ⟨m, L.map Prod.fst, R.map Prod.fst, hcfg⟩ + rcases hclosed1 cfg hsys1 with ⟨cfg', hstep, hnext | hhalt⟩ + · rcases (hiff1 cfg').mp hnext with ⟨m', L1', R1', hcfg'⟩ + refine ⟨cfg', hstep, Or.inl ⟨m', liftPairList L1', liftPairList R1', ?_⟩⟩ + try dsimp + rw [map_fst_liftPairList, map_fst_liftPairList] + exact hcfg' + · exact ⟨cfg', hstep, Or.inr hhalt⟩ + +end BusyBeaver.PairStack diff --git a/BusyBeaver/WordRunStack.lean b/BusyBeaver/WordRunStack.lean new file mode 100644 index 00000000..d911be0b --- /dev/null +++ b/BusyBeaver/WordRunStack.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import BusyBeaver.Basic +public import BusyBeaver.Calculi.Counter +import Mathlib.Data.List.Basic +import Mathlib.Data.Nat.Basic +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring + +@[expose] public section + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.WordRunStack + +set_option linter.style.longLine false +set_option linter.style.setOption false +set_option linter.unusedVariables false +set_option linter.unusedSimpArgs false + +variable {Γ : Type*} [Inhabited Γ] + +theorem append_assoc_blank (u v : List Γ) (lb : ListBlank Γ) : + (u ++ v) +> lb = u +> (v +> lb) := by + induction u with + | nil => rfl + | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] + +theorem nth_cons_zero (x : Γ) (t : ListBlank Γ) : (x >> t).nth 0 = x := by + rw [ListBlank.nth_zero, ListBlank.head_cons] + +theorem nth_cons_succ (x : Γ) (t : ListBlank Γ) (i : ℕ) : (x >> t).nth (i + 1) = t.nth i := by + rw [ListBlank.nth_succ, ListBlank.tail_cons] + +theorem nth_cons_one (x : Γ) (t : ListBlank Γ) : (x >> t).nth 1 = t.nth 0 := + nth_cons_succ x t 0 + +theorem nth_cons_two (x : Γ) (t : ListBlank Γ) : (x >> t).nth 2 = t.nth 1 := + nth_cons_succ x t 1 + +theorem nth_cons_three (x : Γ) (t : ListBlank Γ) : (x >> t).nth 3 = t.nth 2 := + nth_cons_succ x t 2 + +theorem nth_default : ∀ i : ℕ, (default : ListBlank Γ).nth i = default + | 0 => by + rw [ListBlank.nth_zero] + exact ListBlank.head_mk [] + | i + 1 => by + rw [ListBlank.nth_succ] + have htail : (default : ListBlank Γ).tail = default := ListBlank.tail_mk [] + rw [htail] + exact nth_default i + +/-- Extracts the first `n` symbols of a `ListBlank Γ`. -/ +def takeBlank {Γ : Type*} [Inhabited Γ] : ℕ → ListBlank Γ → List Γ + | 0, _ => [] + | n + 1, lb => lb.head :: takeBlank n lb.tail + +theorem takeBlank_length : ∀ (n : ℕ) (lb : ListBlank Γ), (takeBlank n lb).length = n + | 0, _ => rfl + | n + 1, lb => by + simp only [takeBlank, List.length_cons, takeBlank_length n lb.tail] + +theorem nth_takeBlank_append_of_lt : + ∀ (n : ℕ) (lb : ListBlank Γ) (v : List Γ) (t : ListBlank Γ) (i : ℕ), i < n → + ((takeBlank n lb ++ v) +> t).nth i = lb.nth i + | 0, _, _, _, _, h => nomatch h + | n + 1, lb, v, t, 0, _ => by + simp only [takeBlank, List.cons_append, ListBlank.append] + rw [nth_cons_zero, ListBlank.nth_zero] + | n + 1, lb, v, t, i + 1, h => by + simp only [takeBlank, List.cons_append, ListBlank.append] + rw [nth_cons_succ, ListBlank.nth_succ] + exact nth_takeBlank_append_of_lt n lb.tail v t i (Nat.lt_of_succ_lt_succ h) + +theorem nth_takeBlank_append_add : + ∀ (n : ℕ) (lb : ListBlank Γ) (v : List Γ) (t : ListBlank Γ) (j : ℕ), + ((takeBlank n lb ++ v) +> t).nth (n + j) = (v +> t).nth j + | 0, _, _, _, _ => by simp only [takeBlank, List.nil_append, Nat.zero_add] + | n + 1, lb, v, t, j => by + simp only [takeBlank, List.cons_append, ListBlank.append] + rw [Nat.succ_add, nth_cons_succ] + exact nth_takeBlank_append_add n lb.tail v t j + +theorem nth_append_of_lt : + ∀ (v : List Γ) (t : ListBlank Γ) (j : ℕ), j < v.length → (v +> t).nth j = v.getD j default + | [], _, _, h => nomatch h + | x :: v, t, 0, _ => by + simp only [ListBlank.append, List.getD_cons_zero] + exact nth_cons_zero x (v +> t) + | x :: v, t, j + 1, h => by + simp only [ListBlank.append, List.getD_cons_succ] + rw [nth_cons_succ] + exact nth_append_of_lt v t j (Nat.lt_of_succ_lt_succ h) + +def NoFactor (pat : List Γ) (t : ListBlank Γ) : Prop := + ∀ i : ℕ, ¬ ∀ j : ℕ, j < pat.length → t.nth (i + j) = pat.getD j default + +theorem noFactor_default (pat : List Γ) (j : ℕ) (hj : j < pat.length) + (hne : pat.getD j default ≠ default) : NoFactor pat (default : ListBlank Γ) := by + intro i h + exact hne ((h j hj).symm.trans (nth_default (i + j))) + +theorem noFactor_cons_of_nth_ne (pat : List Γ) (x : Γ) (t : ListBlank Γ) (ht : NoFactor pat t) + (j : ℕ) (hj : j < pat.length) (hne : (x >> t).nth j ≠ pat.getD j default) : + NoFactor pat (x >> t) := by + intro i h + cases i with + | zero => exact hne (by simpa using h j hj) + | succ i => + apply ht i + intro j' hj' + have := h j' hj' + rwa [Nat.succ_add, nth_cons_succ] at this + +theorem isNowhereDenseFamily_of_noFactor {S : Type*} (Valid : S → Prop) (enc : S → ListBlank Γ) + (pat : List Γ) (hforb : ∀ s, Valid s → NoFactor pat (enc s)) : + IsNowhereDenseFamily Valid enc := by + intro s hs n + refine ⟨(takeBlank n (enc s) ++ pat) +> default, ?_, ?_⟩ + · intro i hi + exact nth_takeBlank_append_of_lt n _ pat default i hi + · intro s' hs' heq + apply hforb s' hs' n + intro j hj + rw [heq, nth_takeBlank_append_add, nth_append_of_lt pat default j hj] + +theorem isNowhereDenseHalf_of_noFactor {S : Type*} (Valid : S → Prop) + (segs : S → List (SegRegionKind Γ)) (pat : List Γ) + (hforb : ∀ s, Valid s → NoFactor pat (evalSegmentedHalf (segs s))) : + IsNowhereDenseHalf Valid segs := + isNowhereDenseFamily_of_noFactor Valid (fun s => evalSegmentedHalf (segs s)) pat hforb + +end BusyBeaver.WordRunStack diff --git a/BusyBeaverChallenge.lean b/BusyBeaverChallenge.lean index 84ce6f60..31cb1330 100644 --- a/BusyBeaverChallenge.lean +++ b/BusyBeaverChallenge.lean @@ -535,6 +535,45 @@ def HasStackReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] (∀ cfg, IsInStackSystem cfg → ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) +/-- Unifying 2nd-Order Digit-Stack Schema (`IsStackCryptid`). -/ +def IsStackCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (StackMode : Type) + (dSym sSym : Fin (k + 2)) + (encLeft encRight : List (StackTuple (k + 2)) → ListBlank (Fin (k + 2))) + (evalStackCfg : + StackMode → List (StackTuple (k + 2)) → List (StackTuple (k + 2)) → Cfg (Fin (k + 2)) Λ) + (IsInStackSystem : Cfg (Fin (k + 2)) Λ → Prop), + IsValidStackPolarity dSym sSym ∧ + encLeft [] = default ∧ + encRight [] = default ∧ + (∀ a b L, (encLeft ((a, b) :: L)).head = dSym) ∧ + (∀ d b R, (encRight ((d, b) :: R)).head = dSym) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ L : List (StackTuple (k + 2)), encLeft L ≠ t) ∧ + (∃ t : ListBlank (Fin (k + 2)), + t.head = dSym ∧ ∀ R : List (StackTuple (k + 2)), encRight R ≠ t) ∧ + (∃ strideL offsetL sepL maxSepL strideR offsetR sepR maxSepR : ℕ, + strideL > 0 ∧ offsetL > 0 ∧ sepL > 0 ∧ 1 ≤ maxSepL ∧ maxSepL ≤ 4 ∧ + strideR > 0 ∧ offsetR > 0 ∧ sepR > 0 ∧ 1 ≤ maxSepR ∧ maxSepR ≤ 4 ∧ + (∀ a b L, encLeft ((a, b) :: L) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideL * a + offsetL)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepL maxSepL b)) + (encLeft L))) ∧ + (∀ d b R, encRight ((d, b) :: R) = + ListBlank.append (([dSym] : List (Fin (k + 2))) ^ (strideR * d + offsetR)) + (ListBlank.append + (([sSym] : List (Fin (k + 2))) ^ (stackSepLen (n := k + 1) sepR maxSepR b)) + (encRight R)))) ∧ + (∃ modes : List StackMode, modes.length ≤ 6 ∧ ∀ m : StackMode, m ∈ modes) ∧ + IsValidStackModes encLeft encRight evalStackCfg ∧ + (∀ cfg, IsInStackSystem cfg ↔ ∃ m L R, cfg = evalStackCfg m L R) ∧ + (∀ m L R, IsInStackSystem (evalStackCfg m L R)) ∧ + (∃ cfg₀, ReachesPlus M (init []) cfg₀ ∧ IsInStackSystem cfg₀) ∧ + (∀ cfg, IsInStackSystem cfg → + ∃ cfg', ReachesPlus M cfg cfg' ∧ (IsInStackSystem cfg' ∨ (step M cfg').isNone)) + /-- Tape orientation for a mixed-radix odometer-word system (`HasOdometerReduction`). -/ inductive OdomSide where /-- Odometer stack on the left half-tape and active word on the right half-tape. -/ @@ -549,8 +588,12 @@ def evalOdomR {Γ Λ : Type*} [Inhabited Γ] (side : OdomSide) (q_R : Λ) (pfx_R : List Γ) (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := match side with - | .leftOdom => Cfg.headRight q_R (ListBlank.append pfx_R encOdom) w - | .rightOdom => Cfg.headLeft q_R w (ListBlank.append pfx_R encOdom) + | .leftOdom => + (⟨some q_R, ⟨(w : ListBlank Γ).head, + ListBlank.append pfx_R encOdom, (w : ListBlank Γ).tail⟩⟩ : Cfg Γ Λ) + | .rightOdom => + (⟨some q_R, ⟨(w : ListBlank Γ).head, + (w : ListBlank Γ).tail, ListBlank.append pfx_R encOdom⟩⟩ : Cfg Γ Λ) /-- Evaluate the inward-facing odometer entry configuration (head at `q_L` facing the odometer stack `encOdom` across fixed boundary prefix `pfx_L`). -/ @@ -559,8 +602,12 @@ def evalOdomL {Γ Λ : Type*} [Inhabited Γ] (side : OdomSide) (q_L : Λ) (pfx_L : List Γ) (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := match side with - | .leftOdom => Cfg.headLeft q_L encOdom (ListBlank.append pfx_L w) - | .rightOdom => Cfg.headRight q_L (ListBlank.append pfx_L w) encOdom + | .leftOdom => + (⟨some q_L, ⟨(encOdom : ListBlank Γ).head, + (encOdom : ListBlank Γ).tail, ListBlank.append pfx_L w⟩⟩ : Cfg Γ Λ) + | .rightOdom => + (⟨some q_L, ⟨(encOdom : ListBlank Γ).head, + ListBlank.append pfx_L w, (encOdom : ListBlank Γ).tail⟩⟩ : Cfg Γ Λ) /-- The blank-tape trajectory of `M` enters a closed outward-facing odometer-word hub coupled with a non-surjective multi-bit mixed-radix odometer stack (`OdomTok`, `cap`, `dec`, `drain`) supporting @@ -638,6 +685,80 @@ def HasOdometerReduction {k : ℕ} {Λ : Type*} [Inhabited Λ] ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) +/-- Closed mixed-radix odometer-word hub system (`IsOdometerCryptid`). -/ +def IsOdometerCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (OdomTok : Type) + (side : OdomSide) + (q_R : List OdomTok → Λ) + (q_L : Λ) + (pfx_R pfx_L odomBase : List (Fin (k + 2))) + (odomWord : OdomTok → List (Fin (k + 2))) + (encOdom : List OdomTok → ListBlank (Fin (k + 2))) + (cap : List OdomTok → ℕ) + (dec : List OdomTok → List OdomTok) + (decPfx : List OdomTok → List (Fin (k + 2))) + (drain : List OdomTok → List (Fin (k + 2))) + (IsInOdomSystem : Cfg (Fin (k + 2)) Λ → Prop), + (∃ toks : List OdomTok, 2 ≤ toks.length ∧ toks.length ≤ 6 ∧ ∀ t : OdomTok, t ∈ toks) ∧ + odomBase ≠ [] ∧ + (∀ t : OdomTok, 2 ≤ (odomWord t).length) ∧ + encOdom [] = ListBlank.append odomBase default ∧ + (∀ t stk, encOdom (t :: stk) = ListBlank.append (odomWord t) (encOdom stk)) ∧ + (∃ t : ListBlank (Fin (k + 2)), ∀ stk : List OdomTok, encOdom stk ≠ t) ∧ + cap [] = 0 ∧ + (∃ (t_inc t_even t_div : OdomTok) (b : ℕ) (blk_inc blk_div : List (Fin (k + 2))), + 2 ≤ b ∧ 2 ≤ blk_inc.length ∧ 2 ≤ blk_div.length ∧ + (∀ stk, cap (t_inc :: stk) = 2 * cap stk + 1) ∧ + (∀ stk, cap (t_even :: stk) = 2 * cap stk) ∧ + (∀ stk, cap (t_div :: stk) = cap stk / b) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_inc w)) + (evalOdomR side (q_R (t_inc :: stk)) pfx_R (encOdom (t_inc :: stk)) w)) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.append blk_div w)) + (evalOdomR side (q_R (t_div :: stk)) pfx_R (encOdom (t_div :: stk)) w))) ∧ + (∀ stk, (dec stk).length = stk.length) ∧ + (∀ stk, cap stk ≥ 1 → cap (dec stk) = cap stk - 1) ∧ + (∀ stk w, cap stk ≥ 1 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R (dec stk)) pfx_R (encOdom (dec stk)) + (ListBlank.append (decPfx stk) w))) ∧ + (∀ stk, cap stk = 0 → drain stk ≠ []) ∧ + (∀ stk w, cap stk = 0 → + ReachesPlus M + (evalOdomL side q_L pfx_L (encOdom stk) w) + (evalOdomR side (q_R []) pfx_R (encOdom []) (ListBlank.append (drain stk) w))) ∧ + (∀ stk w, + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) (ListBlank.cons (0 : Fin (k + 2)) w)) + (evalOdomL side q_L pfx_L (encOdom stk) (ListBlank.cons (1 : Fin (k + 2)) w))) ∧ + (∀ stk w, + w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0)) → + (∃ t w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomR side (q_R (t :: stk)) pfx_R (encOdom (t :: stk)) w')) ∨ + (∃ w', + ReachesPlus M + (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) + (evalOdomL side q_L pfx_L (encOdom stk) w')) ∨ + (∃ cfg', + ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (step M cfg').isNone)) ∧ + (∀ cfg, IsInOdomSystem cfg ↔ + ∃ stk w, cfg = evalOdomR side (q_R stk) pfx_R (encOdom stk) w) ∧ + (∃ (stk₀ : List OdomTok) (w₀ : ListBlank (Fin (k + 2))), + ReachesPlus M (init []) (evalOdomR side (q_R stk₀) pfx_R (encOdom stk₀) w₀) ∧ + 2 ≤ stk₀.length ∧ 1 ≤ cap stk₀) ∧ + (∀ stk w, + w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0)) → + ∃ cfg', ReachesPlus M (evalOdomR side (q_R stk) pfx_R (encOdom stk) w) cfg' ∧ + (IsInOdomSystem cfg' ∨ (step M cfg').isNone)) + /-- Every `TransducerMode` evaluates `(L, R)` as a fixed control state `q` and fixed bounded `HalfTapeView`s `vL, vR` (`≤ 8`-symbol prefixes) of `encLeft L` and `encRight R` (either scanning `0` between them or stepping onto the left or right view). -/ @@ -797,7 +918,8 @@ def encRegsAux {Γ : Type*} [Inhabited Γ] : (m : ℕ) → (Fin m → List Γ) → (Fin m → ℕ) → ListBlank Γ → ListBlank Γ | 0, _, _, tail => tail | m + 1, rw, r, tail => - ListBlank.append ((rw 0) ^ (r 0)) (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) + ListBlank.append ((rw 0) ^ (r 0)) + (encRegsAux m (fun i => rw i.succ) (fun i => r i.succ) tail) /-- Encodes the bottom accumulator registers + `base` of a `WordStackSpec`. -/ def encRegs {Γ Tok : Type*} [Inhabited Γ] {numRegs : ℕ} @@ -837,10 +959,13 @@ def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m | 0, _, _ => 0 | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) +section +universe u + /-- Prefix length of a `HalfTapeView`. -/ -def viewPrefixLen {Γ : Type*} : HalfTapeView Γ → ℕ - | .id p => p.length - | .tail p => p.length +def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := + v.casesOn (fun p => p.length) (fun p => p.length) +end /-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ structure WordSysState (Mode TokL TokR : Type*) (numRegsL numRegsR : ℕ) where @@ -903,7 +1028,8 @@ def DrainsTop {Γ Tok : Type*} {numRegs : ℕ} (spec : WordStackSpec Γ Tok numRegs) (xs xs' : List (Tok × ℕ)) : Prop := ¬ PreservesOrGrows spec xs xs' -/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is completely popped. -/ +/-- `PopsTop xs xs'` holds when the active top frame `f` of `xs = f :: xs'` is + completely popped. -/ def PopsTop {Tok : Type*} (xs xs' : List (Tok × ℕ)) : Prop := ∃ f, xs = f :: xs' @@ -1097,15 +1223,17 @@ def IsWordRunCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] (∃ s', stepMacro (s_fam d) = some s' ∧ PopsTop (s_fam d).R s'.R ∧ topFrameBitLen specR (s_fam d).R ≤ totalSystemBitLen specL specR s' + 8)))) +universe u v + /-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ -inductive SegRegionKind (Γ : Type*) where +inductive SegRegionKind (Γ : Type u) where | reg (blk : List Γ) (val : ℕ) | wordRun (frames : List (List Γ × ℕ)) | finWord (words : List (List Γ)) | gadget (w : List Γ) /-- Evaluates a single `SegRegionKind Γ` into its `List Γ` bit-segment. -/ -def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ +def evalSegRegion {Γ : Type u} : SegRegionKind Γ → List Γ | .reg blk v => blk ^ v | .wordRun [] => [] | .wordRun ((w, m) :: rest) => (w ^ m) ++ evalSegRegion (.wordRun rest) @@ -1114,7 +1242,7 @@ def evalSegRegion {Γ : Type*} : SegRegionKind Γ → List Γ | .gadget w => w /-- Evaluates a `≤ 3`-region segmented half-tape `List (SegRegionKind Γ)` onto `default`. -/ -def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ +def evalSegmentedHalf {Γ : Type u} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ | [] => default | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) @@ -1123,20 +1251,20 @@ def evalSegmentedHalf {Γ : Type*} [Inhabited Γ] : List (SegRegionKind Γ) → valid state encodes, i.e. the image has empty interior in the prefix topology. A bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ -def IsNowhereDenseFamily {Γ S : Type*} [Inhabited Γ] +def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad /-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ -def IsNowhereDenseHalf {Γ S : Type*} [Inhabited Γ] +def IsNowhereDenseHalf {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) /-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view prefix). -/ -def IsSegmentedCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] +def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] (M : Machine (Fin (k + 2)) Λ) : Prop := ∃ (SegState : Type) (Mode : Type) @@ -9769,3 +9897,465 @@ def machine : ConjectureMachines.Machine 6 2 := abbrev target : Machine (Fin 2) (Fin 6) := machine.toBB theorem is_not_halt : IsNotHalt target := by sorry end BusyBeaver.M_1RBHHH_1RC1RE_1LD0RC_0RE0LD_1LC0LF_1RA0RF + +namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 3, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => none + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH + +namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 3, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.left) + | 5, 1 => none + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH + +namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 0 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => none + +theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH + +namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 0 Dir.right) + | 3, 1 => some (some 5, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 1 Dir.left) + | 5, 0 => some (some 1, Stmt.write 0 Dir.right) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH + +namespace BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 3, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 3, Stmt.write 1 Dir.right) + | 2, 0 => some (some 0, Stmt.write 1 Dir.left) + | 2, 1 => some (some 0, Stmt.write 1 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 0 Dir.left) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 0 Dir.right) + | 5, 1 => none + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 0 Dir.right) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 1, Stmt.write 0 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 0, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 0 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 0 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 0 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH + +namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.left) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 0, Stmt.write 0 Dir.right) + | 2, 1 => some (some 3, Stmt.write 0 Dir.left) + | 3, 0 => some (some 0, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.left) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 4, Stmt.write 1 Dir.left) + | 5, 1 => none + +theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH + +namespace BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE +open Turing BusyBeaver + +/-- Transition function for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 0, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 4, Stmt.write 0 Dir.right) + | 2, 0 => some (some 4, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 1 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.left) + | 3, 1 => none + | 4, 0 => some (some 5, Stmt.write 1 Dir.left) + | 4, 1 => some (some 2, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => some (some 4, Stmt.write 1 Dir.left) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE + +namespace BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH +open Turing BusyBeaver + +/-- Transition function for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 0, Stmt.write 1 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.right) + | 3, 1 => some (some 0, Stmt.write 0 Dir.left) + | 4, 0 => some (some 0, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.right) + | 5, 0 => some (some 0, Stmt.write 0 Dir.right) + | 5, 1 => none + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH + +namespace BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF +open Turing BusyBeaver + +/-- Transition function for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => none + | 2, 0 => some (some 3, Stmt.write 0 Dir.right) + | 2, 1 => some (some 2, Stmt.write 0 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.left) + | 4, 0 => some (some 3, Stmt.write 1 Dir.left) + | 4, 1 => some (some 0, Stmt.write 1 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.right) + | 5, 1 => some (some 5, Stmt.write 0 Dir.left) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF + +namespace BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA +open Turing BusyBeaver + +/-- Transition function for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => none + | 2, 0 => some (some 5, Stmt.write 1 Dir.left) + | 2, 1 => some (some 3, Stmt.write 1 Dir.left) + | 3, 0 => some (some 4, Stmt.write 1 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 2, Stmt.write 0 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.right) + | 5, 0 => some (some 2, Stmt.write 1 Dir.left) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA + +namespace BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA +open Turing BusyBeaver + +/-- Transition function for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 0 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => none + | 2, 0 => some (some 3, Stmt.write 1 Dir.right) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 0 Dir.right) + | 3, 1 => some (some 3, Stmt.write 0 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.left) + | 4, 1 => some (some 2, Stmt.write 1 Dir.left) + | 5, 0 => some (some 4, Stmt.write 1 Dir.left) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA + +namespace BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH +open Turing BusyBeaver + +/-- Transition function for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 5, Stmt.write 1 Dir.right) + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => some (some 0, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 1, Stmt.write 1 Dir.right) + | 3, 0 => some (some 4, Stmt.write 1 Dir.left) + | 3, 1 => some (some 3, Stmt.write 0 Dir.left) + | 4, 0 => some (some 0, Stmt.write 0 Dir.right) + | 4, 1 => some (some 1, Stmt.write 0 Dir.left) + | 5, 0 => some (some 1, Stmt.write 0 Dir.right) + | 5, 1 => none + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH + +namespace BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD +open Turing BusyBeaver + +/-- Transition function for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 0 Dir.right) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 1 Dir.left) + | 2, 1 => some (some 4, Stmt.write 1 Dir.left) + | 3, 0 => some (some 2, Stmt.write 1 Dir.left) + | 3, 1 => some (some 5, Stmt.write 1 Dir.right) + | 4, 0 => some (some 1, Stmt.write 1 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.right) + | 5, 1 => some (some 3, Stmt.write 0 Dir.right) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD + +namespace BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE +open Turing BusyBeaver + +/-- Transition function for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 1 Dir.left) + | 1, 1 => some (some 1, Stmt.write 0 Dir.right) + | 2, 0 => some (some 3, Stmt.write 0 Dir.left) + | 2, 1 => some (some 2, Stmt.write 0 Dir.left) + | 3, 0 => some (some 4, Stmt.write 1 Dir.right) + | 3, 1 => some (some 1, Stmt.write 1 Dir.right) + | 4, 0 => some (some 3, Stmt.write 1 Dir.right) + | 4, 1 => some (some 5, Stmt.write 1 Dir.left) + | 5, 0 => some (some 0, Stmt.write 1 Dir.left) + | 5, 1 => some (some 4, Stmt.write 0 Dir.left) + +theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +end BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE + +namespace BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA +open Turing BusyBeaver + +/-- Transition function for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => none + | 1, 0 => some (some 2, Stmt.write 1 Dir.right) + | 1, 1 => some (some 4, Stmt.write 0 Dir.left) + | 2, 0 => some (some 3, Stmt.write 0 Dir.left) + | 2, 1 => some (some 5, Stmt.write 0 Dir.right) + | 3, 0 => some (some 1, Stmt.write 1 Dir.left) + | 3, 1 => some (some 4, Stmt.write 0 Dir.right) + | 4, 0 => some (some 2, Stmt.write 0 Dir.right) + | 4, 1 => some (some 4, Stmt.write 0 Dir.left) + | 5, 0 => some (some 3, Stmt.write 1 Dir.right) + | 5, 1 => some (some 0, Stmt.write 1 Dir.right) + +theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by sorry +end BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA + +namespace BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE +open Turing BusyBeaver + +/-- Transition function for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +def target_tm : Machine (Fin 2) (Fin 6) + | 0, 0 => some (some 1, Stmt.write 1 Dir.right) + | 0, 1 => some (some 4, Stmt.write 1 Dir.left) + | 1, 0 => some (some 2, Stmt.write 0 Dir.left) + | 1, 1 => some (some 1, Stmt.write 0 Dir.left) + | 2, 0 => some (some 3, Stmt.write 1 Dir.right) + | 2, 1 => some (some 2, Stmt.write 1 Dir.left) + | 3, 0 => some (some 3, Stmt.write 1 Dir.right) + | 3, 1 => some (some 0, Stmt.write 1 Dir.right) + | 4, 0 => some (some 5, Stmt.write 1 Dir.right) + | 4, 1 => some (some 0, Stmt.write 0 Dir.left) + | 5, 0 => none + | 5, 1 => some (some 4, Stmt.write 1 Dir.right) + +theorem is_cryptid : IsCryptid target_tm := by sorry +end BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE diff --git a/CORE_MANIFEST.json b/CORE_MANIFEST.json index a6932ddd..c17b5bff 100644 --- a/CORE_MANIFEST.json +++ b/CORE_MANIFEST.json @@ -4,11 +4,11 @@ "BusyBeaver/Defs.lean": "6bc7f0bec3703ae922c392a5e5ab161f52aee87109efacd85de84d005082a607", "BusyBeaver/Defs/Core.lean": "a9a861b14e2fb24df3fce94bdb625d612f9f158a21b8c5abe6261a26460818e5", "BusyBeaver/Defs/Patterns.lean": "1c3aa83bb4584233d7d4cecc40742e06bd1baf5b3c9397e96361ef4c1421c5c5", - "BusyBeaver/Defs/Stack.lean": "03258c6b05bb7c658643525b133d6abd01650288e8ea9e82053c837ee7146dac", - "BusyBeaver/Defs/Odometer.lean": "aa705cc46d05eb14b9be67cc7a486e40da70065467e32e07d9e9472c29195cf3", + "BusyBeaver/Defs/Stack.lean": "c72377cfde8df4bf3634467bbfa5ead837f818beff11a78540fc19b3c5f16b2b", + "BusyBeaver/Defs/Odometer.lean": "447c59d8748a6913f6c345e238fac56975092075c0c4bcd8ee8aea6cab36f4e4", "BusyBeaver/Defs/Transducer.lean": "12cd7052d69b41417bad77228111411b98c3dd6ec513ae7b6440eb7c23831e9f", - "BusyBeaver/Defs/WordRun.lean": "d7bc8ce1bb58c7b4cace2b0c3e2d3cf238759e5c45cc56cd48d2e77460a04a8e", - "BusyBeaver/Defs/Segmented.lean": "d97b734636fd3adb53d7e57e7db44d35d6cd5dee74983c2306bed1633b5c58c2", + "BusyBeaver/Defs/WordRun.lean": "865bd40c12c48e11d16585acd687f95d7357d19e920a87c4ff26fe176ca77003", + "BusyBeaver/Defs/Segmented.lean": "335324f4070e9d53da4505cc760aa8ab5f27722af7167048b624ed6f1f128ef0", "BusyBeaver/Basic.lean": "35cf96b7db7ce0dbd629af00540121d4f64eb18755774356a4309eee9a6a0c4e", "BusyBeaver/WordRLE.lean": "b819bc8e072a8b2274f60c3cae72f61dbb9057ef9481facbc68801dd4b2ce803", "BusyBeaver/AffRLE.lean": "8434da7a25f766df93481813f0b17286337df21f35ed55f43845ca93b6903e95", diff --git a/comparator/README.md b/comparator/README.md index 31cc4ddd..e8917149 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -20,7 +20,7 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). acceleration semantics (`IsClosedPatternSet`, `HasCollatzReduction`, `IsClosedStackPatternSet`, `HasStackedCollatzReduction`, `HasStackReduction`, `HasOdometerReduction`, `HasTransducerReduction`, `IsValidAcceleration`, `CollatzHalts`, `IsHalt`, `IsNotHalt`), and - `load_rle_machine%` once, and states all 506 `BB(6)` and `BB(3, 3)` holdout theorems + `load_rle_machine%` once, and states all 709 `BB(6)` and `BB(3, 3)` holdout theorems (`is_closed_pattern_set` / `is_closed_stack_pattern_set`, `has_collatz_reduction` / `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, @@ -64,7 +64,7 @@ that: | [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 16 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), first-order `PA` consistency & $\Sigma_1^0$ adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), `Riemann95.candidate_fewer_states`, and the `ErdosTernary14` reduction, and `Brocard28.halts_brocard28_iff_exists_square` | | [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 36 conjecture-checking state-reduction, equivalence, `PA` metatheory & internalized `ZF` provability, and semantics theorems | | [`pa_semantics.json`](./pa_semantics.json) | `Challenge` | `Cryptids.Semantics.PA` | `propext`, `Quot.sound`, `Classical.choice` | `not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`, `paProvable_sound_nat`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent` | -| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 506 `BB(6)` and `BB(3, 3)` holdout Level A, Level B, equivalence, A6 `is_not_halt`, and hardness-evidence theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`, `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, `HardnessEvidence.*`) | +| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 709 `BB(6)` and `BB(3, 3)` holdout Level A, Level B, equivalence, A6 `is_not_halt`, and hardness-evidence theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`, `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, `HardnessEvidence.*`, `is_word_run_cryptid`, `is_segmented_cryptid`, `is_odometer_cryptid`, `is_stack_cryptid`, `is_cryptid`) | | [`a6.json`](./a6.json) | `BusyBeaverChallenge` | `BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH` | `propext`, `Quot.sound`, `Classical.choice` | A6 `is_not_halt` | | [`goldbach_21.json`](./goldbach_21.json) | `Challenge` | `Cryptids.Goldbach21` | `propext`, `Quot.sound` | `candidate_fewer_states`, `candidate_equivalent` | | [`goldbach_semantics.json`](./goldbach_semantics.json) | `Challenge` | `Cryptids.Semantics.Goldbach` | `propext`, `Quot.sound`, `Classical.choice` | `halts_reference_iff_not_goldbach`, `halts_candidate_iff_not_goldbach` | diff --git a/comparator/busy_beaver.json b/comparator/busy_beaver.json index 6461ef3a..8a0b0339 100644 --- a/comparator/busy_beaver.json +++ b/comparator/busy_beaver.json @@ -699,11 +699,58 @@ "BusyBeaver.M_1RBHHH_1RC0RF_1RD0RA_1LE1RB_1LB0LE_0RB0LC.is_not_halt", "BusyBeaver.M_1RBHHH_1RC1LF_1LD1RE_1LB0LD_1RA0RC_1RC0LE.is_not_halt", "BusyBeaver.M_1RBHHH_1RC1RA_1RD0RB_1LE1RC_1LF0LE_1RC0LC.is_not_halt", - "BusyBeaver.M_1RBHHH_1RC1RE_1LD0RC_0RE0LD_1LC0LF_1RA0RF.is_not_halt" + "BusyBeaver.M_1RBHHH_1RC1RE_1LD0RC_0RE0LD_1LC0LF_1RA0RF.is_not_halt", + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.is_odometer_cryptid", + "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.is_segmented_cryptid", + "BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.is_segmented_cryptid", + "BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.is_segmented_cryptid", + "BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.is_segmented_cryptid", + "BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.is_segmented_cryptid", + "BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.is_segmented_cryptid", + "BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.is_segmented_cryptid", + "BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.is_odometer_cryptid", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.is_cryptid" ], "permitted_axioms": [ "propext", "Quot.sound", "Classical.choice" + ], + "definition_names": [ + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.target_tm", + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.target_tm", + "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.target_tm", + "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.target_tm", + "BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.target_tm", + "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.target_tm", + "BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.target_tm", + "BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.target_tm", + "BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.target_tm", + "BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.target_tm", + "BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.target_tm", + "BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.target_tm", + "BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.target_tm", + "BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.target_tm", + "BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.target_tm", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.target_tm", + "BusyBeaver.viewPrefixLen" ] -} +} \ No newline at end of file From 84cc3ba8395a1bde38ebcc2f9d65b9e1f640ca4b Mon Sep 17 00:00:00 2001 From: Tom Zahavy Date: Wed, 11 Nov 2026 13:47:45 +0000 Subject: [PATCH 7/7] Address PR #29 review feedback: tighten core defs, upgrade #424, expose closed segmented systems, clean style & docs --- ...LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean | 446 ++-- ...LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean | 439 ++-- ...LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean | 191 +- ...LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean | 589 +++-- ...LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean | 545 ++-- ...LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean | 578 +++-- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean | 778 +++--- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean | 767 +++--- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean | 852 ++++--- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean | 680 ++--- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean | 648 +++-- ...LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean | 782 +++--- ...RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean | 450 ++-- ...RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean | 450 ++-- ...RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean | 440 ++-- ...RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean | 437 ++-- ...RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean | 441 ++-- ...RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean | 452 ++-- ...HH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean | 440 ++-- ...HH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean | 443 ++-- ...HH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean | 194 +- BusyBeaver/BB6/Accelerations/README.md | 4 +- ...LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean | 2209 +++++------------ BusyBeaver/BB6/README.md | 8 +- BusyBeaver/Defs/Segmented.lean | 92 +- BusyBeaver/Defs/WordRun.lean | 21 +- BusyBeaver/README.md | 8 +- BusyBeaver/Stack.lean | 56 +- BusyBeaver/WordRunStack.lean | 5 - BusyBeaverChallenge.lean | 1279 +++++++--- CORE_MANIFEST.json | 4 +- README.md | 2 +- comparator/README.md | 14 +- comparator/busy_beaver.json | 43 +- 34 files changed, 8066 insertions(+), 6721 deletions(-) diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean index 59640901..a50b4c3c 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 0, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 0 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -132,91 +132,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := evalSegRegion_zWord (leftList m L) @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for Holdout `#729`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨k, _, rfl⟩ + exact zWord_ne_nil k + · intro h + rcases List.mem_map.mp (h 0) with ⟨k, _, hk⟩ + exact zWord_ne_zero k hk + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨p, _, rfl⟩ + exact rWord_ne_nil p + · intro h + rcases List.mem_map.mp (h 0) with ⟨p, _, hp⟩ + exact rWord_ne_zero p hp @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -231,7 +286,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -275,7 +330,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -312,57 +367,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -370,143 +425,144 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -573,24 +629,22 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, - Or.inr segsR_nowhere_dense, - Or.inr segsL_boundary_aligned, - Or.inl segsR_nowhere_dense, - ⟨s₀, trivial, init_reaches_segmented_system⟩, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, + Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean index d2b2520f..ff08bbba 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 0, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 0 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 2, Stmt.write 1 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -126,91 +126,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft L := evalSegRegion_zWord L @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -225,7 +280,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -269,7 +324,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -306,57 +361,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -364,143 +419,142 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt L o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mAL L ((1, 0) :: (z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -565,24 +619,25 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mAL, L, (1, 0) :: (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mAL, L, (1, 0) :: (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean index 7dcc2658..fb0d92ab 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` — `is_odometer_cryptid` (`IsOdometerCryptid target_tm`) +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` (`IsOdometerCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsOdometerCryptid` proof for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 3, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 0 Dir.left) @@ -49,64 +45,64 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 2000000 -set_option maxRecDepth 10000 - -@[simp] lemma zMz (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 0 = some config := rfl -@[simp] lemma zMo (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 1 = step M config := rfl -@[simp] lemma zMs (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : Nat) : + +@[simp] private theorem zMz {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) : + multiStep M config 0 = some config := rfl +@[simp] private theorem zMo {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) : + multiStep M config 1 = step M config := rfl +@[simp] private theorem zMs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) (n : Nat) : multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] -@[simp] lemma z00 : (0 : Fin 2) >> default = default := by +@[simp] private theorem z00 : (0 : Fin 2) >> default = default := by apply Turing.ListBlank.ext; intro i; cases i <;> rfl -@[simp] lemma zDh : (default : zB).head = 0 := rfl -@[simp] lemma zDt : (default : zB).tail = default := rfl +@[simp] private theorem zDh : (default : zB).head = 0 := rfl +@[simp] private theorem zDt : (default : zB).tail = default := rfl -lemma zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] -lemma z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢⁺ c₂ := ⟨1, by decide, zSm tm c₁ c₂ h⟩ -lemma zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ : Cfg Γ Λ) (n m : Nat) : multiStep tm c₁ (n + m) = (multiStep tm c₁ n).bind (fun c₂ => multiStep tm c₂ m) := by induction m with | zero => simp | succ m' ih => rw [Nat.add_succ, zMs, ih, Option.bind_assoc]; simp_rw [zMs] -lemma zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ c3 : Cfg Γ Λ) (n m : Nat) (h1 : c₁ [tm]⊢^{n} c₂) (h2 : c₂ [tm]⊢^{m} c3) : c₁ [tm]⊢^{n+m} c3 := by rw [zMa, h1]; simp [h2] -lemma zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ : Cfg Γ Λ} (h : c₁ [tm]⊢⁺ c₂) : c₁ [tm]⊢* c₂ := by obtain ⟨n, _, hn⟩ := h; exact ⟨n, hn⟩ -lemma z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := by obtain ⟨n, n_pos, hn⟩ := h1; obtain ⟨m, hm⟩ := h2 exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c₁ c₂ c3 n m hn hm⟩ -lemma z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := z02 (z01 tm c₁ c₂ h1) h2 -lemma zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢⁺ c3) : c₁ [tm]⊢⁺ c3 := z02 h1 (zPs h2) @@ -115,32 +111,33 @@ local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine zPs ?_) <;> refine z03 (by (try simp only [Turing.ListBlank.head_cons, zDh]); rfl) ?_ <;> - simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, z00, zDh, zDt]) + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + Tape.write, z00, zDh, zDt]) local macro "execute" : tactic => `(tactic| repeat (any_goals (first | finish | gstep))) -lemma fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by +private theorem fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by match b with | ⟨0, _⟩ => left; rfl | ⟨1, _⟩ => right; rfl -inductive OdomTok where +private inductive OdomTok where | L0 | L1 | L2 deriving DecidableEq, Repr @[simp] -def odomWord : OdomTok → List (Fin 2) +private def odomWord : OdomTok → List (Fin 2) | .L0 => [0, 0, 1, 0] | .L1 => [1, 0, 1, 0] | .L2 => [1, 1, 0] @[simp] -def encOdom : List OdomTok → zB +private def encOdom : List OdomTok → zB | [] => [1] +> default | t :: l => odomWord t +> encOdom l -lemma encOdom_non_surjective : +private theorem encOdom_non_surjective : ∃ t : zB, ∀ stk : List OdomTok, encOdom stk ≠ t := by refine ⟨default, fun stk h => ?_⟩ cases stk with @@ -153,7 +150,8 @@ lemma encOdom_non_surjective : | L0 => have h1 : (encOdom (.L0 :: tl)).tail.tail.head = (default : zB).tail.tail.head := congrArg (fun x => x.tail.tail.head) h - simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, zDt, zDh] at h1 + simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, + zDt, zDh] at h1 revert h1; decide | L1 => have h1 : (encOdom (.L1 :: tl)).head = (default : zB).head := congrArg ListBlank.head h @@ -164,74 +162,77 @@ lemma encOdom_non_surjective : simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 revert h1; decide -@[simp] def state_R (_ : List OdomTok) : Fin 6 := 2 +@[simp] private def state_R (_ : List OdomTok) : Fin 6 := 2 -@[simp] def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := +@[simp] private def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := evalOdomR .leftOdom (state_R l) [1, 0] (encOdom l) r -@[simp] def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := +@[simp] private def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := evalOdomL .leftOdom 0 [1, 0] (encOdom l) r -def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w -def init_w0 : zB := default +private def init_w0 : zB := default -lemma step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by +private theorem step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl - rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append, z00]; execute + rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append + ]; execute -lemma step_R_0 (l : List OdomTok) (r : zB) : +private theorem step_R_0 (l : List OdomTok) (r : zB) : (cfg_R l ((0 : Fin 2) >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append]; execute -lemma step_R_100 (l : List OdomTok) (r : zB) : +private theorem step_R_100 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 0 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L2 :: l) r := by - simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append]; execute -lemma step_R_11 (l : List OdomTok) (r : zB) : +private theorem step_R_11 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 1 >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append]; execute -lemma step_R_1010 (l : List OdomTok) (r : zB) : +private theorem step_R_1010 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L0 :: l) r := by - simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_L0 (l : List OdomTok) (r : zB) : +private theorem step_L_L0 (l : List OdomTok) (r : zB) : (cfg_L (.L0 :: l) r) [target_tm]⊢⁺ cfg_R (.L1 :: l) r := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append + ]; execute -lemma step_L_L1 (l : List OdomTok) (r : zB) : +private theorem step_L_L1 (l : List OdomTok) (r : zB) : (cfg_L (.L1 :: l) r) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r) := by - simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_L2 (l : List OdomTok) (r : zB) : +private theorem step_L_L2 (l : List OdomTok) (r : zB) : (cfg_L (.L2 :: l) r) [target_tm]⊢⁺ cfg_L l ((0 : Fin 2) >> 1 >> 0 >> r) := by - simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_nil (r : zB) : +private theorem step_L_nil (r : zB) : (cfg_L [] r) [target_tm]⊢⁺ cfg_R [] ((1 : Fin 2) >> 0 >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append]; execute @[simp] -def cap : List OdomTok → Nat +private def cap : List OdomTok → Nat | [] => 0 | .L0 :: l => 2 * cap l + 1 | .L1 :: l => 2 * cap l | .L2 :: l => cap l / 3 @[simp] -def dec_fuel : Nat → List OdomTok → List OdomTok +private def dec_fuel : Nat → List OdomTok → List OdomTok | 0, l => l | _ + 1, [] => [] | _ + 1, .L0 :: l => .L1 :: l | n + 1, .L1 :: l => .L0 :: dec_fuel n l | n + 1, .L2 :: l => .L2 :: dec_fuel n (dec_fuel n (dec_fuel n l)) -def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l +private def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l @[simp] -lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := by +private theorem length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := + by induction n generalizing l with | zero => rfl | succ n ih => @@ -240,16 +241,16 @@ lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.l | cons t tl => cases t <;> simp [dec_fuel, ih] @[simp] -lemma length_dec (l : List OdomTok) : (dec l).length = l.length := +private theorem length_dec (l : List OdomTok) : (dec l).length = l.length := length_dec_fuel l.length l -@[simp] lemma dec_nil : dec [] = [] := rfl -@[simp] lemma dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl -@[simp] lemma dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl -@[simp] lemma dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by +@[simp] private theorem dec_nil : dec [] = [] := rfl +@[simp] private theorem dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl +@[simp] private theorem dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl +@[simp] private theorem dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by simp only [dec, List.length_cons, dec_fuel, length_dec_fuel] -lemma cap_dec_aux (n : Nat) : +private theorem cap_dec_aux (n : Nat) : ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → cap (dec l) = cap l - 1 := by induction n with | zero => @@ -277,10 +278,10 @@ lemma cap_dec_aux (n : Nat) : have ih3 := ih (dec (dec l)) hlen2 (by omega) rw [ih3, ih2, ih1]; omega -lemma cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := +private theorem cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := cap_dec_aux l.length l (Nat.le_refl _) h -lemma runHL_dec_aux (n : Nat) : +private theorem runHL_dec_aux (n : Nat) : ∀ (l : List OdomTok) (r : zB), l.length ≤ n → cap l ≥ 1 → (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := by induction n with @@ -318,30 +319,30 @@ lemma runHL_dec_aux (n : Nat) : (zPpp (ih (dec (dec l)) _ hlen2 (by omega)) (step_R_100 (dec (dec (dec l))) r)))))) -lemma runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : +private theorem runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := runHL_dec_aux l.length l r (Nat.le_refl _) h @[simp] -def mod3Bits (c : Nat) : List (Fin 2) := +private def mod3Bits (c : Nat) : List (Fin 2) := if c % 3 = 0 then [0, 1, 0] else if c % 3 = 1 then [1, 1, 0] else [1, 0, 0] @[simp] -def drain : List OdomTok → List (Fin 2) +private def drain : List OdomTok → List (Fin 2) | [] => [1, 0] | .L0 :: tl => drain tl ++ [1, 0, 1, 0] | .L1 :: tl => drain tl ++ [1, 0, 1, 0] | .L2 :: tl => drain tl ++ mod3Bits (cap tl) -lemma drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] +private theorem drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] | [] => by decide | .L0 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ | .L1 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ | .L2 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ -lemma drain_dec_aux (n : Nat) : +private theorem drain_dec_aux (n : Nat) : ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → drain (dec l) = drain l := by induction n with | zero => @@ -377,16 +378,16 @@ lemma drain_dec_aux (n : Nat) : rw [hrem] rw [ih3, ih2, ih1, hmod] -lemma drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := +private theorem drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := drain_dec_aux l.length l (Nat.le_refl _) hcap -lemma append_list_assoc (xs ys : List (Fin 2)) (w : zB) : +private theorem append_list_assoc (xs ys : List (Fin 2)) (w : zB) : (xs ++ ys) +> w = xs +> (ys +> w) := by induction xs with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma run_drain_aux (n : Nat) : +private theorem run_drain_aux (n : Nat) : ∀ (l : List OdomTok) (w : zB), l.length ≤ n → cap l = 0 → (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := by induction n with @@ -440,14 +441,14 @@ lemma run_drain_aux (n : Nat) : (zPpp (runHL_dec (dec tl) ((1 : Fin 2) >> 1 >> 0 >> w) (by omega)) (zPpp (step_R_11 (dec (dec tl)) ((0 : Fin 2) >> w)) h_ih)))) -lemma run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : +private theorem run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := run_drain_aux l.length l w (Nat.le_refl _) hcap -def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := +private def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) -lemma stepL_state_sound (l : List OdomTok) (w : zB) : +private theorem stepL_state_sound (l : List OdomTok) (w : zB) : (cfg_L l w) [target_tm]⊢⁺ cfg_R (stepL_state l w).1 (stepL_state l w).2 := by unfold stepL_state split_ifs with hcap @@ -455,7 +456,7 @@ lemma stepL_state_sound (l : List OdomTok) (w : zB) : · have hz : cap l = 0 := by omega exact run_drain l w hz -lemma step_R_partition (l : List OdomTok) (w : zB) +private theorem step_R_partition (l : List OdomTok) (w : zB) (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : (∃ t w', (cfg_R l w) [target_tm]⊢⁺ cfg_R (t :: l) w') ∨ (∃ w', (cfg_R l w) [target_tm]⊢⁺ cfg_L l w') ∨ @@ -491,7 +492,7 @@ lemma step_R_partition (l : List OdomTok) (w : zB) · rw [h1] at hg0; nomatch hg0 · rw [h11] at hg1; nomatch hg1 -lemma step_R_closed (l : List OdomTok) (w : zB) +private theorem step_R_closed (l : List OdomTok) (w : zB) (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : ∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ (IsInOdomSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -502,7 +503,7 @@ lemma step_R_closed (l : List OdomTok) (w : zB) Or.inl ⟨(stepL_state l w').1, (stepL_state l w').2, rfl⟩⟩ · exact ⟨cfg_halt, hhalt, Or.inr hnone⟩ -lemma step_init_nontrivial : +private theorem step_init_nontrivial : (init []) [target_tm]⊢⁺ cfg_R [.L0, .L2, .L0] default := by have h0 : (init []) [target_tm]⊢⁺ cfg_R [] default := step_init have h1 : (cfg_R [] default) [target_tm]⊢⁺ cfg_L [] ((1 : Fin 2) >> default) := by @@ -528,11 +529,9 @@ lemma step_init_nontrivial : exact zPpp h0 (zPpp h1 (zPpp h2 (zPpp h3 (zPpp h4 (zPpp h5 (zPpp h6 (zPpp h7 (zPpp h8 (zPpp h9 (zPpp h10 h11)))))))))) --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by +theorem is_odometer_cryptid : IsOdometerCryptid target := by + rw [target_eq_target_tm] refine ⟨OdomTok, .leftOdom, state_R, 0, [1, 0], [1, 0], [1], odomWord, encOdom, cap, dec, (fun _ => []), drain, IsInOdomSystem, ?_, ?_, ?_, rfl, ?_, encOdom_non_surjective, rfl, ?_, length_dec, cap_dec, runHL_dec, (fun stk _ => drain_ne_nil stk), run_drain, diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean index 13f80ee7..6944f359 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 3, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 0 Dir.left) @@ -49,45 +45,49 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 1, Stmt.write 0 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 2 -def B : Fin 6 := 0 -def C : Fin 6 := 1 -def D : Fin 6 := 4 -def E : Fin 6 := 3 -def F : Fin 6 := 5 +private def A : Fin 6 := 2 +private def B : Fin 6 := 0 +private def C : Fin 6 := 1 +private def D : Fin 6 := 4 +private def E : Fin 6 := 3 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -@[simp] lemma pow_zero_list (u : List (Fin 2)) : u ^ (0 : Nat) = [] := rfl -@[simp] lemma pow_succ_list (u : List (Fin 2)) (n : Nat) : u ^ (n + 1) = u ++ u ^ n := rfl -@[simp] lemma nil_append_list (l : List (Fin 2)) : ([] : List (Fin 2)) ++ l = l := rfl -@[simp] lemma cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : (x :: xs) ++ ys = x :: (xs ++ ys) := rfl -@[simp] lemma append_nil_list (l : List (Fin 2)) : l ++ [] = l := List.append_nil l -@[simp] lemma listblank_append_nil (b : ListBlank (Fin 2)) : ([] : List (Fin 2)) +> b = b := rfl -@[simp] lemma listblank_append_cons (x : Fin 2) (xs : List (Fin 2)) (b : ListBlank (Fin 2)) : +@[simp] private theorem pow_zero_list (u : List (Fin 2)) : u ^ (0 : Nat) = [] := rfl +@[simp] private theorem pow_succ_list (u : List (Fin 2)) (n : Nat) : u ^ (n + 1) = u ++ u ^ n := rfl +@[simp] private theorem nil_append_list (l : List (Fin 2)) : ([] : List (Fin 2)) ++ l = l := rfl +@[simp] private theorem cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : + (x :: xs) ++ ys = x :: (xs ++ ys) := rfl +@[simp] private theorem append_nil_list (l : List (Fin 2)) : l ++ [] = l := List.append_nil l +@[simp] private theorem listblank_append_nil (b : ListBlank (Fin 2)) : ([] : List (Fin 2)) +> + b = b := rfl +@[simp] private theorem listblank_append_cons (x : Fin 2) (xs : List (Fin 2)) (b : + ListBlank (Fin 2)) : (x :: xs) +> b = x >> (xs +> b) := rfl -@[simp] lemma zero_cons_default : (0 : Fin 2) >> default = default := by +@[simp] private theorem zero_cons_default : (0 : Fin 2) >> default = default := by apply Turing.ListBlank.ext; intro i; cases i <;> rfl -@[simp] lemma default_head : (default : ListBlank (Fin 2)).head = 0 := rfl -@[simp] lemma default_tail : (default : ListBlank (Fin 2)).tail = default := rfl -@[simp] lemma init_nil : (init ([] : List (Fin 2))) = ⟨some B, ⟨0, default, default⟩⟩ := rfl +@[simp] private theorem default_head : (default : ListBlank (Fin 2)).head = 0 := rfl +@[simp] private theorem default_tail : (default : ListBlank (Fin 2)).tail = default := rfl +@[simp] private theorem init_nil : (init ([] : List (Fin 2))) = ⟨some B, ⟨0, default, default⟩⟩ := + rfl -omit [Inhabited Γ] in -theorem list_pow_add (l : List Γ) (n m : Nat) : l^(n + m) = l^n ++ l^m := +private theorem list_pow_add {Γ : Type*} (l : List Γ) (n m : Nat) : l^(n + m) = l^n ++ l^m := BusyBeaver.list_pow_add l n m -@[simp] lemma zero_pow_append_default (n : ℕ) : +@[simp] private theorem zero_pow_append_default (n : ℕ) : (([0] : List (Fin 2)) ^ n) +> (default : ListBlank (Fin 2)) = default := by induction n with | zero => rfl | succ n' ih => - rw [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, zero_cons_default] + rw [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, + zero_cons_default] -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -95,157 +95,168 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ @@ -254,46 +265,47 @@ lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b local notation3 l " <{{" q "}}ₘ " r => (r {{q}}> l) -abbrev cfgA (l r : ListBlank (Fin 2)) : Cfg (Fin 2) (Fin 6) := +private abbrev cfgA (l r : ListBlank (Fin 2)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, r, l⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := evalStackCfg .M0 R L -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma in_stack_M0 (L R : List (ℕ × ℕ)) : IsInStackSystem (cfg_M0 L R) := +private theorem in_stack_M0 (L R : List (ℕ × ℕ)) : IsInStackSystem (cfg_M0 L R) := ⟨.M0, R, L, rfl⟩ -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = cfgA (encTail L) (encTail R) := by simp [cfg_M0, evalStackCfg, cfgA, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -332,7 +344,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -364,12 +376,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_head_one (l r : ListBlank (Fin 2)) : +private theorem F_halt_head_one (l r : ListBlank (Fin 2)) : (step target_tm ⟨some F, ⟨1, l, r⟩⟩).isNone = true := by unfold step simp only [F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [], ?_, in_stack_M0 [] []⟩ rw [init_nil, cfg_M0_eq, encTail_nil] @@ -379,63 +391,68 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}}ₘ ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := cfgA (W +> wall L'') (encRight R) -inductive FState +private inductive FState | F00 | F01 | F02 | F04 | F05 | F07 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}}ₘ ((0 : Fin 2) >> encRight R) | .F01, L'', W, R => (W +> wall L'') <{{D}}ₘ ((0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{C}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F04, L'', W, R => (W +> wall L'') <{{A}}ₘ ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{D}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F07, L'', W, R => (W +> wall L'') <{{A}}ₘ ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{D}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => + (W +> wall L'') <{{A}}ₘ ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) -- ============================================================================ -- Stage 1: `cfg_M0 L R` -> `cfg_M0`, Halt, or `cfg_D 0` -- ============================================================================ -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 5 -lemma M0_add3 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add3 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((d + 3, bR) :: R')) [target_tm]⊢⁺ - ⟨some F, ⟨1, encTail ((d, bR) :: R'), (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L⟩⟩ := by + ⟨some F, ⟨1, encTail ((d, bR) :: R'), + (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L⟩⟩ := by rw [cfg_M0_eq, encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d] execute 3 -theorem stage1_step (L R : List (ℕ × ℕ)) : +private theorem stage1_step (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -450,52 +467,52 @@ theorem stage1_step (L R : List (ℕ × ℕ)) : -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -def measureD : List (ℕ × ℕ) → ℕ +private def measureD : List (ℕ × ℕ) → ℕ | [] => 0 | (a, _) :: L => a + 1 + measureD L -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ cfgA tL ((1 : Fin 2) >> rD) := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ cfgA ((0 : Fin 2) >> tL) ((0 : Fin 2) >> (1 : Fin 2) >> rD) := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ (tL <{{D}}ₘ ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}}ₘ rD) [target_tm]⊢⁺ cfgA ((0 : Fin 2) >> tL) ((1 : Fin 2) >> rD) := by execute 5 -lemma D_leaf_1 (tL rD' : ListBlank (Fin 2)) : +private theorem D_leaf_1 (tL rD' : ListBlank (Fin 2)) : (((1 : Fin 2) >> tL) <{{D}}ₘ ((0 : Fin 2) >> rD')) [target_tm]⊢⁺ (tL <{{D}}ₘ ((0 : Fin 2) >> (1 : Fin 2) >> rD')) := by execute 3 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -504,12 +521,14 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, c) :: tailAsRight R))⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, + c) :: tailAsRight R))⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases a₁ with _ | a₁' @@ -519,7 +538,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, c) :: tailAsRight R))⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 [] ((1, + c) :: tailAsRight R))⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -540,72 +560,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp [measureD]; omega, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp [measureD]; omega, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -620,24 +663,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -645,7 +694,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -654,7 +704,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -663,7 +714,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl (in_stack_M0 _ _)⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl (in_stack_M0 _ _)⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = a₁' + 1 -> D_leaf_1 @@ -673,7 +725,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rcases c with _ | c' · -- c = 0 refine ⟨cfg_D 0 ((a₁', b₁) :: L') (rightAsTail (tailAsRight R)), ?_, - Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', rightAsTail (tailAsRight R), by decide, by simp [measureD], rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', rightAsTail (tailAsRight R), by decide, + by simp [measureD], rfl⟩))⟩ unfold cfg_D rw [encTail_rightAsTail, encRight_tailAsRight] dsimp only [rD, pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, @@ -682,14 +735,16 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- c = c' + 1 have hc' : c' < 4 := by omega refine ⟨cfg_D 0 ((a₁', b₁) :: L') ((0, c') :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', (0, c') :: tailAsRight R, by decide, by simp [measureD], rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨0, (a₁', b₁) :: L', (0, c') :: tailAsRight R, by decide, + by simp [measureD], rfl⟩))⟩ unfold cfg_D rw [← one_cons_RD_eq c' hc' R] dsimp only [rD, pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] - exact D_leaf_1 (encTail ((a₁', b₁) :: L')) ((([0] : List (Fin 2)) ^ (1 + c')) +> ((1 : Fin 2) >> encTail R)) + exact D_leaf_1 (encTail ((a₁', + b₁) :: L')) ((([0] : List (Fin 2)) ^ (1 + c')) +> ((1 : Fin 2) >> encTail R)) -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, measureD L ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -717,30 +772,30 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) -- ============================================================================ -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ +private def C0 : FState → ℕ | .F00 => 0 | .F01 => 0 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 -def C1 : FState → ℕ +private def C1 : FState → ℕ | .F00 => 1 | .F01 => 1 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -748,7 +803,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -758,20 +813,21 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by rw [w_peelInner_zero b S h] rcases S with _ | ⟨r₂, rs⟩ @@ -779,7 +835,7 @@ lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · simp [w]; omega -- Stage 3 P transitions -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -788,9 +844,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -798,7 +855,7 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -807,9 +864,10 @@ lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 5 -lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, + 0) :: peelInner b R_tail) := by unfold P_cfg rw [encRight_one_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -817,64 +875,68 @@ lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : +private theorem P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : + List (ℕ × ℕ)) : (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ - ⟨some F, ⟨1, encTail ((a, b) :: R_tail), (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (W +> wall L'')⟩⟩ := by + ⟨some F, ⟨1, encTail ((a, b) :: R_tail), + (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (W +> wall L'')⟩⟩ := by dsimp only [P_cfg] rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_eq_one_cons_encTail a b R_tail] execute 3 -- Stage 3 F transitions on bit 0 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 4 +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -- Stage 3 F transitions on bit 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 3 +private theorem F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 3 -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W ((0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 3 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -- Pushdown predicate & bit-step combinators -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -882,11 +944,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : Stage3Out start L'' W_out W_bound C1 := by cases s with | F00 => - exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => - exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ | F02 => - have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + have hne : bumpHead R₁ ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F04 => @@ -897,12 +964,14 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ | F05 => - exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ | F07 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -917,11 +986,15 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ | F01 => - have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + have hne : bumpHead R₁ ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] refine Or.inr ⟨.F01, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ rw [w_bumpHead R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F02 => - exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ | F04 => refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega @@ -932,7 +1005,7 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1035,26 +1108,35 @@ theorem stage3_ind (W_val : ℕ) : exact ⟨hQ0, hQz, hQz1⟩ -- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 -lemma F01_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F07_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 - -lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +private theorem F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by cases s with | F00 => exact ⟨_, _, F00_exit L'' R⟩ @@ -1064,7 +1146,7 @@ lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : | F05 => exact ⟨_, _, F05_exit L'' R⟩ | F07 => exact ⟨_, _, F07_exit L'' R⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1077,7 +1159,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Closure & Main Theorem -- ============================================================================ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1097,11 +1179,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, @@ -1121,13 +1201,13 @@ theorem is_stack_cryptid : IsStackCryptid target_tm := by -- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield -- ============================================================================ -lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} +private theorem stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ -lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by @@ -1145,7 +1225,7 @@ lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ -lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by @@ -1162,7 +1242,8 @@ lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (ih (0 :: 0 :: 1 :: W)) /-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ -lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : + L_rest ≠ []) : (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ @@ -1184,7 +1265,7 @@ lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (h exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD /-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ -lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by induction k generalizing R with @@ -1207,7 +1288,7 @@ lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L (ih ((0, 2) :: tailAsRight R)) /-- Stage 2 empty-left-stack return to `cfg_M0`. -/ -lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1217,21 +1298,21 @@ lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting mode closure for `evalStackCfg .M0 ((1, bR) :: R') L`. -/ -theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 ((1, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 (peelSep bR R') ((0, 0) :: tailAsRight L), M0_one L bR R', in_stack_M0 ((0, 0) :: tailAsRight L) (peelSep bR R')⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 ((2, bR) :: R') L`. -/ -theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 ((2, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 (peelSep bR R') ((0, 1) :: tailAsRight L), M0_two L bR R', in_stack_M0 ((0, 1) :: tailAsRight L) (peelSep bR R')⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ -theorem mode_M0_nil_nil_nonhalting : +private theorem mode_M0_nil_nil_nonhalting : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], @@ -1240,21 +1321,21 @@ theorem mode_M0_nil_nil_nonhalting : /-- Refined reachable stack subset for Holdout `#278`: canonical `evalStackCfg m L R` configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ -def ValidStack278 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def ValidStack278 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) -theorem validStack278_subset_isInStackSystem : +private theorem validStack278_subset_isInStackSystem : ∀ cfg, ValidStack278 cfg → IsInStackSystem cfg := by intro cfg ⟨m, L, R, hcfg, _⟩ exact ⟨m, L, R, hcfg⟩ -theorem cfg_M0_nil_nil_reaches_validStack278 : +private theorem cfg_M0_nil_nil_reaches_validStack278 : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack278 cfg' := ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), ⟨.M0, (1, 0) :: tailAsRight [], [], rfl, Or.inl (by simp)⟩⟩ -theorem init_reaches_validStack278 : +private theorem init_reaches_validStack278 : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack278 cfg₀ := by have h0 : (init []) [target_tm]⊢⁺ evalStackCfg .M0 [] [] := by change (init []) [target_tm]⊢⁺ cfg_M0 [] [] @@ -1263,7 +1344,7 @@ theorem init_reaches_validStack278 : obtain ⟨cfg₁, h₁, hvalid₁⟩ := cfg_M0_nil_nil_reaches_validStack278 exact ⟨cfg₁, stepPlus_trans h0 h₁, hvalid₁⟩ -theorem stack_system_steps_to_validStack278 : +private theorem stack_system_steps_to_validStack278 : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack278 cfg' ∨ (step target_tm cfg').isNone) := by @@ -1282,7 +1363,7 @@ theorem stack_system_steps_to_validStack278 : Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ -theorem validStack278_step_closed : +private theorem validStack278_step_closed : ∀ cfg, ValidStack278 cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack278 cfg' ∨ (step target_tm cfg').isNone) := @@ -1290,7 +1371,7 @@ theorem validStack278_step_closed : stack_system_steps_to_validStack278 cfg (validStack278_subset_isInStackSystem cfg hvalid) /-- Stage 2 singleton-zero return to `cfg_M0`. -/ -lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : +private theorem D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1302,7 +1383,7 @@ lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ exact D_leaf_00 (encTail []) rD /-- Stage 2 transition from `cfg_D c ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') R` into `P_cfg`. -/ -lemma D_00_13_to_P (c : ℕ) (hc : c < 4) (a₃ b₃ : ℕ) (L''' R : List (ℕ × ℕ)) : +private theorem D_00_13_to_P (c : ℕ) (hc : c < 4) (a₃ b₃ : ℕ) (L''' R : List (ℕ × ℕ)) : (cfg_D c ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''') R) [target_tm]⊢⁺ P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) := by unfold cfg_D @@ -1324,7 +1405,7 @@ lemma D_00_13_to_P (c : ℕ) (hc : c < 4) (a₃ b₃ : ℕ) (L''' R : List (ℕ exact D_leaf_011 _ rD /-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [] [(0, b₁)]`. -/ -theorem mode_M0_nil_singleton_zero_nonhalting (b₁ : ℕ) : +private theorem mode_M0_nil_singleton_zero_nonhalting (b₁ : ℕ) : ∃ cfg', ((evalStackCfg .M0 [] [(0, b₁)]) [target_tm]⊢⁺ cfg') ∧ ValidStack278 cfg' := ⟨evalStackCfg .M0 ((1, 0) :: tailAsRight []) [], @@ -1334,7 +1415,7 @@ theorem mode_M0_nil_singleton_zero_nonhalting (b₁ : ℕ) : /-- Stage 1 halting counterexample family in `ValidStack278`: any `evalStackCfg .M0 ((d + 3, bR) :: R') L` satisfies `ValidStack278` and halts in 3 steps via `M0_add3` and `F_halt_head_one`. -/ -theorem counterexample_validStack278_M0_add3_halts +private theorem counterexample_validStack278_M0_add3_halts (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : ValidStack278 (evalStackCfg .M0 ((d + 3, bR) :: R') L) ∧ ∃ cfg', ((evalStackCfg .M0 ((d + 3, bR) :: R') L) [target_tm]⊢⁺ cfg') ∧ @@ -1348,7 +1429,7 @@ theorem counterexample_validStack278_M0_add3_halts `evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')` satisfies `ValidStack278`, enters Stage 2 via `M0_zero`, transitions to Stage 3 via `D_00_13_to_P`, pops `(0, 0)` via `P_step_0_rec`, and halts via `P_step_ge2`. -/ -theorem counterexample_validStack278_stage3_P_ge2_halts +private theorem counterexample_validStack278_stage3_P_ge2_halts (a b a₃ b₃ : ℕ) (R_tail L''' : List (ℕ × ℕ)) : ValidStack278 (evalStackCfg .M0 ((0, 0) :: (a + 1, b) :: R_tail) ((0, 0) :: (1, 3) :: (a₃, b₃) :: L''')) ∧ diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean index 9ebc83b2..616dc555 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 3, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 0 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 0 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -78,28 +70,35 @@ inductive SegMode where | mEL deriving DecidableEq, Repr -@[simp] -def onesSep0 : ℕ → List (Fin 2) - | 0 => [0] - | d + 1 => 1 :: onesSep0 d +def onesSep0 (d : ℕ) : List (Fin 2) := + Nat.rec [0] (fun _ acc => 1 :: acc) d + +@[simp] private theorem onesSep0_zero : onesSep0 0 = [0] := rfl +@[simp] private theorem onesSep0_succ (d : ℕ) : + onesSep0 (d + 1) = 1 :: onesSep0 d := rfl @[simp] def lWord (d : ℕ) : List (Fin 2) := 1 :: onesSep0 d -@[simp] -def encLeft : List ℕ → zB - | [] => default - | d :: L => lWord d +> encLeft L +def encLeft (S : List ℕ) : zB := + List.rec default (fun d _ acc => lWord d +> acc) S -@[simp] -def rWord : ℕ → List (Fin 2) - | 0 => [1] - | z + 1 => 0 :: rWord z +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (d : ℕ) (S : List ℕ) : + encLeft (d :: S) = lWord d +> encLeft S := rfl -@[simp] -def encRight : List ℕ → zB - | [] => default - | z :: R => rWord z +> encRight R +def rWord (z : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) z + +@[simp] private theorem rWord_zero : rWord 0 = [1] := rfl +@[simp] private theorem rWord_succ (z : ℕ) : rWord (z + 1) = 0 :: rWord z := rfl + +def encRight (S : List ℕ) : zB := + List.rec default (fun z _ acc => rWord z +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (z : ℕ) (S : List ℕ) : + encRight (z :: S) = rWord z +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List ℕ @@ -117,49 +116,49 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_lWord (L : List ℕ) : +private theorem evalSegRegion_lWord (L : List ℕ) : evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default -lemma evalSegRegion_rWord (R : List ℕ) : +private theorem evalSegRegion_rWord (R : List ℕ) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List ℕ) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List ℕ) : evalSegmentedHalf (segsL (m, L, R)) = encLeft L := evalSegRegion_lWord L @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List ℕ) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List ℕ) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma enc_nth_zero (d : ℕ) (L : List ℕ) : +private theorem enc_nth_zero (d : ℕ) (L : List ℕ) : (encLeft (d :: L)).nth 0 = 1 := by - simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + simp only [encLeft_cons, lWord, ListBlank.append, WordRunStack.nth_cons_zero] -lemma noFactor_001_nil (d : ℕ) : +private theorem noFactor_001_nil (d : ℕ) : WordRunStack.NoFactor [0, 0, 1] (lWord d +> (default : zB)) := by have hd : WordRunStack.NoFactor [0, 0, 1] (default : zB) := WordRunStack.noFactor_default [0, 0, 1] 2 (by decide) (by decide) induction d with | zero => - simp only [lWord, onesSep0, ListBlank.append, zero_cons_default] + simp only [lWord, onesSep0_zero, ListBlank.append, zero_cons_default] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) default hd 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ d ih => @@ -167,12 +166,12 @@ lemma noFactor_001_nil (d : ℕ) : exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_001_cons (d : ℕ) (t : zB) (ht0 : t.nth 0 = 1) +private theorem noFactor_001_cons (d : ℕ) (t : zB) (ht0 : t.nth 0 = 1) (ht : WordRunStack.NoFactor [0, 0, 1] t) : WordRunStack.NoFactor [0, 0, 1] (lWord d +> t) := by induction d with | zero => - simp only [lWord, onesSep0, ListBlank.append] + simp only [lWord, onesSep0_zero, ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) @@ -183,20 +182,67 @@ lemma noFactor_001_cons (d : ℕ) (t : zB) (ht0 : t.nth 0 = 1) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_enc : ∀ L : List ℕ, WordRunStack.NoFactor [0, 0, 1] (encLeft L) +private theorem noFactor_enc : ∀ L : List ℕ, WordRunStack.NoFactor [0, 0, 1] (encLeft L) | [] => WordRunStack.noFactor_default [0, 0, 1] 2 (by decide) (by decide) | [d] => noFactor_001_nil d | d :: d2 :: L => noFactor_001_cons d (encLeft (d2 :: L)) (enc_nth_zero d2 L) (noFactor_enc (d2 :: L)) -lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := +theorem segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 1] (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_enc L) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ +def modes : List SegMode := [.mAR, .mA0R, .mEL] + +private theorem rWord_ne_nil (k : ℕ) : rWord k ≠ [] := by + cases k <;> simp [rWord_zero, rWord_succ] + +private theorem rWord_ne_zero : ∀ k : ℕ, rWord k ≠ [(0 : Fin 2)] + | 0 => by simp [rWord_zero] + | n + 1 => fun h => by + dsimp only [rWord_zero, rWord_succ] at h + exact rWord_ne_nil n (List.cons.inj h).2 + +private theorem onesSep0_len (d : ℕ) : 1 ≤ (onesSep0 d).length := by + induction d with + | zero => decide + | succ _ _ => simp only [onesSep0_succ, List.length_cons]; omega + +private theorem lWord_len (d : ℕ) : 2 ≤ (lWord d).length := by + have h := onesSep0_len d + simp only [lWord, List.length_cons] + omega + +private theorem lWord_ne_nil (d : ℕ) : lWord d ≠ [] := by + intro h; have hlen := lWord_len d; rw [h] at hlen; contradiction + +private theorem lWord_ne_zero (d : ℕ) : lWord d ≠ [(0 : Fin 2)] := by + intro h; have hlen := lWord_len d; rw [h] at hlen; simp at hlen + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact lWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact lWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List ℕ → Cfg (Fin 2) (Fin 6) @@ -208,7 +254,7 @@ def evalSegCfg : SegMode → List ℕ → List ℕ → Cfg (Fin 2) (Fin 6) def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -237,7 +283,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsR_boundary_aligned : +theorem segsR_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vL, (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ @@ -254,31 +300,33 @@ def bump1L : List ℕ → List ℕ | [] => [0] | d :: xs => (d + 1) :: xs -lemma one_cons_encLeft (xs : List ℕ) : +private theorem one_cons_encLeft (xs : List ℕ) : (1 : Fin 2) >> encLeft xs = encLeft (bump1L xs) := by - cases xs <;> simp [bump1L, encLeft, lWord, onesSep0, ListBlank.append, zero_cons_default] + cases xs <;> simp [bump1L, encLeft_nil, encLeft_cons, lWord, onesSep0_zero, onesSep0_succ, + ListBlank.append] @[simp] def push0R : List ℕ → List ℕ | [] => [] | z :: xs => (z + 1) :: xs -lemma zero_cons_encRight (xs : List ℕ) : +private theorem zero_cons_encRight (xs : List ℕ) : (0 : Fin 2) >> encRight xs = encRight (push0R xs) := by - cases xs <;> simp [push0R, encRight, rWord, ListBlank.append, zero_cons_default] + cases xs <;> simp [push0R, encRight_nil, encRight_cons, rWord_succ] @[simp] def s₀ : SegState := (.mAR, (0 :: []), (1 :: [])) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: []) (1 :: []) := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, encRight_cons, lWord, + rWord_zero, rWord_succ, onesSep0_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma stepOut_trans {c1 c2 : Cfg (Fin 2) (Fin 6)} +private theorem stepOut_trans {c1 c2 : Cfg (Fin 2) (Fin 6)} (h1 : c1 [target_tm]⊢⁺ c2) (h2 : ∃ cfg', (c2 [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone)) : @@ -287,280 +335,361 @@ lemma stepOut_trans {c1 c2 : Cfg (Fin 2) (Fin 6)} rcases h2 with ⟨cfg', h2p, hend⟩ exact ⟨cfg', stepPlus_trans h1 h2p, hend⟩ -lemma step_mAR_2_loop (L : List ℕ) (Rt : List ℕ) : +private theorem step_mAR_2_loop (L : List ℕ) (Rt : List ℕ) : (evalSegCfg .mAR L (2 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: bump1L L) Rt := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_1 (L : List ℕ) : +private theorem step_mAR_1 (L : List ℕ) : (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mAR (bump1L L) (1 :: []) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, ← one_cons_encLeft, + encRight_nil, encRight_cons, rWord_zero, rWord_succ, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_2 (Rt : List ℕ) : +private theorem step_mAR_2 (Rt : List ℕ) : (evalSegCfg .mAR [] (0 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mEL [] (0 :: (push0R Rt)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_nil, encRight_cons, rWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_3 (lt2 : List ℕ) (Rt : List ℕ) : +private theorem step_mAR_3 (lt2 : List ℕ) (Rt : List ℕ) : (evalSegCfg .mAR (0 :: lt2) (0 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0R (bump1L lt2) (push0R Rt) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_4 (lt2 : List ℕ) (Rt : List ℕ) : +private theorem step_mAR_4 (lt2 : List ℕ) (Rt : List ℕ) : (evalSegCfg .mAR (1 :: lt2) (0 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mEL (0 :: lt2) (push0R (push0R Rt)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_5 (l3 : ℕ) (lt2 : List ℕ) (Rt : List ℕ) : +private theorem step_mAR_5 (l3 : ℕ) (lt2 : List ℕ) (Rt : List ℕ) : (evalSegCfg .mAR ((l3 + 2) :: lt2) (0 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mEL ((l3 + 1) :: lt2) (push0R (push0R Rt)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_6 (L : List ℕ) : +private theorem step_mAR_6 (L : List ℕ) : (evalSegCfg .mAR L (1 :: [])) [target_tm]⊢⁺ evalSegCfg .mEL (bump1L (bump1L L)) (0 :: []) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, + encRight_nil, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_7 (L : List ℕ) (rt3 : List ℕ) : +private theorem step_mAR_7 (L : List ℕ) (rt3 : List ℕ) : (evalSegCfg .mAR L (1 :: (0 :: rt3))) [target_tm]⊢⁺ evalSegCfg .mEL (bump1L (bump1L L)) (push0R rt3) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_8 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : +private theorem step_mAR_8 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : (evalSegCfg .mAR L (1 :: ((r3 + 1) :: rt3))) [target_tm]⊢⁺ evalSegCfg .mEL (bump1L (bump1L L)) (0 :: (r3 :: rt3)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_9 (L : List ℕ) (r3 : ℕ) (Rt : List ℕ) : +private theorem step_mAR_9 (L : List ℕ) (r3 : ℕ) (Rt : List ℕ) : (evalSegCfg .mAR L ((r3 + 3) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump1L L) (1 :: (r3 :: Rt)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← one_cons_encLeft, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_10 (L : List ℕ) : +private theorem step_mA0R_10 (L : List ℕ) : (evalSegCfg .mA0R L []) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: L) (1 :: []) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_nil, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0R_11 (rt1 : List ℕ) : +private theorem step_mA0R_11 (rt1 : List ℕ) : (evalSegCfg .mA0R [] (0 :: rt1)) [target_tm]⊢⁺ evalSegCfg .mEL [] (0 :: (push0R rt1)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_nil, encRight_cons, rWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mA0R_12 (lt2 : List ℕ) (rt1 : List ℕ) : +private theorem step_mA0R_12 (lt2 : List ℕ) (rt1 : List ℕ) : (evalSegCfg .mA0R (0 :: lt2) (0 :: rt1)) [target_tm]⊢⁺ evalSegCfg .mEL (0 :: lt2) (0 :: (push0R rt1)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_13 (l2 : ℕ) (lt2 : List ℕ) (rt1 : List ℕ) : +private theorem step_mA0R_13 (l2 : ℕ) (lt2 : List ℕ) (rt1 : List ℕ) : (evalSegCfg .mA0R ((l2 + 1) :: lt2) (0 :: rt1)) [target_tm]⊢⁺ evalSegCfg .mEL ((l2 + 1) :: lt2) (0 :: (push0R rt1)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_14 (L : List ℕ) : +private theorem step_mA0R_14 (L : List ℕ) : (evalSegCfg .mA0R L (1 :: [])) [target_tm]⊢⁺ evalSegCfg .mEL (1 :: L) (0 :: []) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_nil, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_15 (L : List ℕ) (rt3 : List ℕ) : +private theorem step_mA0R_15 (L : List ℕ) (rt3 : List ℕ) : (evalSegCfg .mA0R L (1 :: (0 :: rt3))) [target_tm]⊢⁺ evalSegCfg .mEL (1 :: L) (push0R rt3) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_16 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : +private theorem step_mA0R_16 (L : List ℕ) (r3 : ℕ) (rt3 : List ℕ) : (evalSegCfg .mA0R L (1 :: ((r3 + 1) :: rt3))) [target_tm]⊢⁺ evalSegCfg .mEL (1 :: L) (0 :: (r3 :: rt3)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_17 (L : List ℕ) : +private theorem step_mA0R_17 (L : List ℕ) : (evalSegCfg .mA0R L (2 :: [])) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: (0 :: L)) [] := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_nil, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0R_18 (L : List ℕ) (rt4 : List ℕ) : +private theorem step_mA0R_18 (L : List ℕ) (rt4 : List ℕ) : (evalSegCfg .mA0R L (2 :: (0 :: rt4))) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: (0 :: L)) (0 :: rt4) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_19 (L : List ℕ) (r4 : ℕ) (rt4 : List ℕ) : +private theorem step_mA0R_19 (L : List ℕ) (r4 : ℕ) (rt4 : List ℕ) : (evalSegCfg .mA0R L (2 :: ((r4 + 1) :: rt4))) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: (0 :: L)) ((r4 + 1) :: rt4) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0R_20 (L : List ℕ) (r3 : ℕ) (rt1 : List ℕ) : +private theorem step_mA0R_20 (L : List ℕ) (r3 : ℕ) (rt1 : List ℕ) : (evalSegCfg .mA0R L ((r3 + 3) :: rt1)) [target_tm]⊢⁺ evalSegCfg .mAR (0 :: L) (1 :: (r3 :: rt1)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mEL_21 : +private theorem step_mEL_21 : (evalSegCfg .mEL [] []) [target_tm]⊢⁺ evalSegCfg .mA0R (0 :: []) [] := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, + encLeft_nil, encLeft_cons, encRight_nil, lWord, onesSep0_zero, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mEL_22_halt (rt2 : List ℕ) : +private theorem step_mEL_22_halt (rt2 : List ℕ) : ∃ cfg_h, ((evalSegCfg .mEL [] (0 :: rt2)) [target_tm]⊢⁺ cfg_h) ∧ (step target_tm cfg_h).isNone := by - have h1 : (evalSegCfg .mEL [] (0 :: rt2)) [target_tm]⊢⁺ (((1 : Fin 2) >> (encLeft [])) {{5}}> ((1 : Fin 2) >> (encRight rt2))) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, rWord, onesSep0, + have h1 : (evalSegCfg .mEL [] (0 :: rt2)) [target_tm]⊢⁺ + (((1 : Fin 2) >> (encLeft [])) {{5}}> ((1 : Fin 2) >> (encRight rt2))) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute refine ⟨_, h1, ?_⟩ simp [step, target_tm, Turing.ListBlank.head_cons] -lemma step_mEL_23 (rt2 : List ℕ) : +private theorem step_mEL_23 (rt2 : List ℕ) : (evalSegCfg .mEL [] (1 :: rt2)) [target_tm]⊢⁺ evalSegCfg .mA0R (0 :: []) (0 :: rt2) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, + encLeft_nil, encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mEL_24 (r3 : ℕ) (rt2 : List ℕ) : +private theorem step_mEL_24 (r3 : ℕ) (rt2 : List ℕ) : (evalSegCfg .mEL [] ((r3 + 2) :: rt2)) [target_tm]⊢⁺ evalSegCfg .mA0R (0 :: []) ((r3 + 1) :: rt2) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, + simp only [evalSegCfg, applyView, + encLeft_nil, encLeft_cons, encRight_cons, lWord, rWord_succ, + onesSep0_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mEL_25 (lt1 : List ℕ) (R : List ℕ) : +private theorem step_mEL_25 (lt1 : List ℕ) (R : List ℕ) : (evalSegCfg .mEL (0 :: lt1) R) [target_tm]⊢⁺ evalSegCfg .mAR lt1 (push0R (push0R R)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, lWord, onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mEL_26 (lt1 : List ℕ) (R : List ℕ) : +private theorem step_mEL_26 (lt1 : List ℕ) (R : List ℕ) : (evalSegCfg .mEL (1 :: lt1) R) [target_tm]⊢⁺ evalSegCfg .mA0R lt1 (0 :: (push0R R)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mEL_27 (l2 : ℕ) (lt1 : List ℕ) (R : List ℕ) : +private theorem step_mEL_27 (l2 : ℕ) (lt1 : List ℕ) (R : List ℕ) : (evalSegCfg .mEL ((l2 + 2) :: lt1) R) [target_tm]⊢⁺ evalSegCfg .mAR (l2 :: lt1) (0 :: (push0R R)) := by - simp only [evalSegCfg, applyView, ← one_cons_encLeft, ← zero_cons_encRight, encLeft, encRight, lWord, rWord, onesSep0, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_drain (L : List ℕ) (R : List ℕ) : +private theorem step_mAR_drain (L : List ℕ) (R : List ℕ) : ∃ cfg', ((evalSegCfg .mAR L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by induction R generalizing L with | nil => - exact ⟨evalCfg (.mAR, (bump1L L), (1 :: [])), step_mAR_1 L, Or.inl ⟨(.mAR, (bump1L L), (1 :: [])), trivial, rfl⟩⟩ + exact ⟨evalCfg (.mAR, (bump1L L), (1 :: [])), + step_mAR_1 L, + Or.inl ⟨(.mAR, (bump1L L), (1 :: [])), trivial, rfl⟩⟩ | cons hd Rt ih => rcases hd with _ | _ | _ | r3 · rcases L with _ | ⟨_ | l2, lt2⟩ - · exact ⟨evalCfg (.mEL, [], (0 :: (push0R Rt))), step_mAR_2 Rt, Or.inl ⟨(.mEL, [], (0 :: (push0R Rt))), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mA0R, (bump1L lt2), (push0R Rt)), step_mAR_3 lt2 Rt, Or.inl ⟨(.mA0R, (bump1L lt2), (push0R Rt)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, [], (0 :: (push0R Rt))), + step_mAR_2 Rt, + Or.inl ⟨(.mEL, [], (0 :: (push0R Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (bump1L lt2), (push0R Rt)), + step_mAR_3 lt2 Rt, + Or.inl ⟨(.mA0R, (bump1L lt2), (push0R Rt)), trivial, rfl⟩⟩ · rcases l2 with _ | l3 - · exact ⟨evalCfg (.mEL, (0 :: lt2), (push0R (push0R Rt))), step_mAR_4 lt2 Rt, Or.inl ⟨(.mEL, (0 :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), step_mAR_5 l3 lt2 Rt, Or.inl ⟨(.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (0 :: lt2), (push0R (push0R Rt))), + step_mAR_4 lt2 Rt, + Or.inl ⟨(.mEL, (0 :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), + step_mAR_5 l3 lt2 Rt, + Or.inl ⟨(.mEL, ((l3 + 1) :: lt2), (push0R (push0R Rt))), trivial, rfl⟩⟩ · rcases Rt with _ | ⟨_ | r3, rt3⟩ - · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: [])), step_mAR_6 L, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: [])), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (push0R rt3)), step_mAR_7 L rt3, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (push0R rt3)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), step_mAR_8 L r3 rt3, Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: [])), + step_mAR_6 L, + Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: [])), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (push0R rt3)), + step_mAR_7 L rt3, + Or.inl ⟨(.mEL, (bump1L (bump1L L)), (push0R rt3)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), + step_mAR_8 L r3 rt3, + Or.inl ⟨(.mEL, (bump1L (bump1L L)), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ · exact stepOut_trans (step_mAR_2_loop L Rt) (ih (0 :: bump1L L)) - · exact ⟨evalCfg (.mAR, (bump1L L), (1 :: (r3 :: Rt))), step_mAR_9 L r3 Rt, Or.inl ⟨(.mAR, (bump1L L), (1 :: (r3 :: Rt))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (bump1L L), (1 :: (r3 :: Rt))), + step_mAR_9 L r3 Rt, + Or.inl ⟨(.mAR, (bump1L L), (1 :: (r3 :: Rt))), trivial, rfl⟩⟩ -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List ℕ) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List ℕ) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with | mAR => exact step_mAR_drain L R | mA0R => rcases R with _ | ⟨_ | r1, rt1⟩ - · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: [])), step_mA0R_10 L, Or.inl ⟨(.mAR, (0 :: L), (1 :: [])), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: [])), + step_mA0R_10 L, + Or.inl ⟨(.mAR, (0 :: L), (1 :: [])), trivial, rfl⟩⟩ · rcases L with _ | ⟨_ | l2, lt2⟩ - · exact ⟨evalCfg (.mEL, [], (0 :: (push0R rt1))), step_mA0R_11 rt1, Or.inl ⟨(.mEL, [], (0 :: (push0R rt1))), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, (0 :: lt2), (0 :: (push0R rt1))), step_mA0R_12 lt2 rt1, Or.inl ⟨(.mEL, (0 :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), step_mA0R_13 l2 lt2 rt1, Or.inl ⟨(.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, [], (0 :: (push0R rt1))), + step_mA0R_11 rt1, + Or.inl ⟨(.mEL, [], (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (0 :: lt2), (0 :: (push0R rt1))), + step_mA0R_12 lt2 rt1, + Or.inl ⟨(.mEL, (0 :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), + step_mA0R_13 l2 lt2 rt1, + Or.inl ⟨(.mEL, ((l2 + 1) :: lt2), (0 :: (push0R rt1))), trivial, rfl⟩⟩ · rcases r1 with _ | r2 · rcases rt1 with _ | ⟨_ | r3, rt3⟩ - · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: [])), step_mA0R_14 L, Or.inl ⟨(.mEL, (1 :: L), (0 :: [])), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, (1 :: L), (push0R rt3)), step_mA0R_15 L rt3, Or.inl ⟨(.mEL, (1 :: L), (push0R rt3)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: (r3 :: rt3))), step_mA0R_16 L r3 rt3, Or.inl ⟨(.mEL, (1 :: L), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: [])), + step_mA0R_14 L, + Or.inl ⟨(.mEL, (1 :: L), (0 :: [])), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (push0R rt3)), + step_mA0R_15 L rt3, + Or.inl ⟨(.mEL, (1 :: L), (push0R rt3)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mEL, (1 :: L), (0 :: (r3 :: rt3))), + step_mA0R_16 L r3 rt3, + Or.inl ⟨(.mEL, (1 :: L), (0 :: (r3 :: rt3))), trivial, rfl⟩⟩ · rcases r2 with _ | r3 · rcases rt1 with _ | ⟨_ | r4, rt4⟩ - · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), []), step_mA0R_17 L, Or.inl ⟨(.mAR, (0 :: (0 :: L)), []), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), (0 :: rt4)), step_mA0R_18 L rt4, Or.inl ⟨(.mAR, (0 :: (0 :: L)), (0 :: rt4)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), step_mA0R_19 L r4 rt4, Or.inl ⟨(.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: (r3 :: rt1))), step_mA0R_20 L r3 rt1, Or.inl ⟨(.mAR, (0 :: L), (1 :: (r3 :: rt1))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), []), + step_mA0R_17 L, + Or.inl ⟨(.mAR, (0 :: (0 :: L)), []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), (0 :: rt4)), + step_mA0R_18 L rt4, + Or.inl ⟨(.mAR, (0 :: (0 :: L)), (0 :: rt4)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), + step_mA0R_19 L r4 rt4, + Or.inl ⟨(.mAR, (0 :: (0 :: L)), ((r4 + 1) :: rt4)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (0 :: L), (1 :: (r3 :: rt1))), + step_mA0R_20 L r3 rt1, + Or.inl ⟨(.mAR, (0 :: L), (1 :: (r3 :: rt1))), trivial, rfl⟩⟩ | mEL => rcases L with _ | ⟨_ | l1, lt1⟩ · rcases R with _ | ⟨_ | r2, rt2⟩ - · exact ⟨evalCfg (.mA0R, (0 :: []), []), step_mEL_21, Or.inl ⟨(.mA0R, (0 :: []), []), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (0 :: []), []), + step_mEL_21, + Or.inl ⟨(.mA0R, (0 :: []), []), trivial, rfl⟩⟩ · rcases step_mEL_22_halt rt2 with ⟨cfg_h, hp, hh⟩; exact ⟨cfg_h, hp, Or.inr hh⟩ · rcases r2 with _ | r3 - · exact ⟨evalCfg (.mA0R, (0 :: []), (0 :: rt2)), step_mEL_23 rt2, Or.inl ⟨(.mA0R, (0 :: []), (0 :: rt2)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mA0R, (0 :: []), ((r3 + 1) :: rt2)), step_mEL_24 r3 rt2, Or.inl ⟨(.mA0R, (0 :: []), ((r3 + 1) :: rt2)), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mAR, lt1, (push0R (push0R R))), step_mEL_25 lt1 R, Or.inl ⟨(.mAR, lt1, (push0R (push0R R))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (0 :: []), (0 :: rt2)), + step_mEL_23 rt2, + Or.inl ⟨(.mA0R, (0 :: []), (0 :: rt2)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mA0R, (0 :: []), ((r3 + 1) :: rt2)), + step_mEL_24 r3 rt2, + Or.inl ⟨(.mA0R, (0 :: []), ((r3 + 1) :: rt2)), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, lt1, (push0R (push0R R))), + step_mEL_25 lt1 R, + Or.inl ⟨(.mAR, lt1, (push0R (push0R R))), trivial, rfl⟩⟩ · rcases l1 with _ | l2 - · exact ⟨evalCfg (.mA0R, lt1, (0 :: (push0R R))), step_mEL_26 lt1 R, Or.inl ⟨(.mA0R, lt1, (0 :: (push0R R))), trivial, rfl⟩⟩ - · exact ⟨evalCfg (.mAR, (l2 :: lt1), (0 :: (push0R R))), step_mEL_27 l2 lt1 R, Or.inl ⟨(.mAR, (l2 :: lt1), (0 :: (push0R R))), trivial, rfl⟩⟩ - -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : + · exact ⟨evalCfg (.mA0R, lt1, (0 :: (push0R R))), + step_mEL_26 lt1 R, + Or.inl ⟨(.mA0R, lt1, (0 :: (push0R R))), trivial, rfl⟩⟩ + · exact ⟨evalCfg (.mAR, (l2 :: lt1), (0 :: (push0R R))), + step_mEL_27 l2 lt1 R, + Or.inl ⟨(.mAR, (l2 :: lt1), (0 :: (push0R R))), trivial, rfl⟩⟩ + +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAR, .mA0R, .mEL], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inl segsL_nowhere_dense, Or.inl segsL_nowhere_dense, Or.inr segsR_boundary_aligned, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean index 01d14b03..53457e16 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,20 +45,20 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 4, Stmt.write 0 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -70,197 +66,209 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -299,7 +307,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -331,12 +339,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -348,85 +356,96 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F04 | F05 | F07 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) - | .F01, L'', W, R => (W +> wall L'') <{{F}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F01, L'', W, R => + (W +> wall L'') <{{F}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) -- ============================================================================ -- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` -- ============================================================================ -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by +private theorem M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, + 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by have hb4 : bR % 4 + 1 < 4 := by omega rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_pushZeroSep _ hb4] have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] execute 6 -lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : +private theorem M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, + encTail_nil] execute 6 -lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by +private theorem M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : + ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, + 3) :: (d₂, b₂) :: R'') := by rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] execute 9 -lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by +private theorem M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, + bR) :: R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] execute 6 -theorem stage1_step (L R : List (ℕ × ℕ)) : +private theorem stage1_step (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -441,60 +460,62 @@ theorem stage1_step (L R : List (ℕ × ℕ)) : · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ - · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ - · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, + 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', + bR) :: R', rfl⟩⟩ -- ============================================================================ -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 3 -lemma D_leaf_10 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_10 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, rD⟩⟩ := by execute 4 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((0 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -503,7 +524,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R have hrD_zero : rD = encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ @@ -520,7 +542,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -541,72 +564,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -621,24 +667,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -646,7 +698,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -655,7 +708,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -664,14 +718,17 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD - · -- a₁ = 1 -> Leaf 10 bounces directly in 4 steps to cfg_M0 ((0, b₁) :: L') ((0, c) :: tailAsRight R) + · -- a₁ = 1 -> Leaf 10 bounces directly in 4 steps to cfg_M0 ((0, b₁) :: L') ((0, c) :: + -- tailAsRight R) have hL : encTail ((1, b₁) :: L') = (1 : Fin 2) >> (0 : Fin 2) >> ((([0] : List (Fin 2)) ^ (b₁ % 4)) +> encRight L') := by rw [encTail_succ, encTail_zero, zero_pow_one_add (b₁ % 4), listblank_append_cons] - have hL0 : (0 : Fin 2) >> ((([0] : List (Fin 2)) ^ (b₁ % 4)) +> encRight L') = encTail ((0, b₁) :: L') := by + have hL0 : (0 : Fin 2) >> ((([0] : List (Fin 2)) ^ (b₁ % 4)) +> + encRight L') = encTail ((0, b₁) :: L') := by rw [encTail_zero, zero_pow_one_add (b₁ % 4), listblank_append_cons] rw [hL] refine ⟨cfg_M0 ((0, b₁) :: L') ((0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ @@ -685,7 +742,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((0 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -713,30 +770,30 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) -- ============================================================================ -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ +private def C0 : FState → ℕ | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 -def C1 : FState → ℕ +private def C1 : FState → ℕ | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -744,7 +801,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -754,34 +811,35 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by rw [w_peelInner_zero b S h] rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -- Stage 3 P transitions -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -790,9 +848,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -800,7 +859,7 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -809,9 +868,10 @@ lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 3 -lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, + 0) :: peelInner b R_tail) := by unfold P_cfg rw [encRight_one_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -819,64 +879,68 @@ lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 7 -lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : - (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by +private theorem P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : + List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, + b) :: R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail a b R_tail] execute 11 -- Stage 3 F transitions on bit 0 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 7 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 4 +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -- Stage 3 F transitions on bit 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 -lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 1 +private theorem F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -- Pushdown predicate & bit-step combinators -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -884,12 +948,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : Stage3Out start L'' W_out W_bound C1 := by cases s with | F00 => - exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => refine Or.inr ⟨.F04, (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F02 => - have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + have hne : bumpHead R₁ ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F04 => @@ -900,12 +968,14 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ | F05 => - exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ | F07 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -922,17 +992,19 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : | F01 => exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ | F02 => - exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ | F04 => refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F05 => - exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ | F07 => refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1039,29 +1111,38 @@ theorem stage3_ind (W_val : ℕ) : exact ⟨hQ0, hQz, hQz1⟩ -- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 0) :: (0, 2) :: tailAsRight L'') ((0, 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 0) :: (0, + 2) :: tailAsRight L'') ((0, 0) :: R) := by dsimp only [F_cfg, wall] rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 0, encRight_cons_simp 0 2, encRight_tailAsRight, encTail_zero 0] execute 15 -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F07_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 - -lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +private theorem F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by cases s with | F00 => exact ⟨_, _, F00_exit L'' R⟩ @@ -1071,7 +1152,7 @@ lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : | F05 => exact ⟨_, _, F05_exit L'' R⟩ | F07 => exact ⟨_, _, F07_exit L'' R⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1084,7 +1165,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Closure & Main Theorem -- ============================================================================ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1102,11 +1183,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, @@ -1126,13 +1205,13 @@ theorem is_stack_cryptid : IsStackCryptid target_tm := by -- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield -- ============================================================================ -lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} +private theorem stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ -lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by @@ -1150,7 +1229,7 @@ lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ -lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by @@ -1167,7 +1246,8 @@ lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (ih (0 :: 0 :: 1 :: W)) /-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ -lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : + L_rest ≠ []) : (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ @@ -1189,7 +1269,7 @@ lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (h exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD /-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ -lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by induction k generalizing R with @@ -1212,7 +1292,7 @@ lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L (ih ((0, 2) :: tailAsRight R)) /-- Stage 2 empty-left-stack return to `cfg_M0`. -/ -lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1222,28 +1302,28 @@ lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ -theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ -theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ -theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ -theorem mode_M0_nil_nil_nonhalting : +private theorem mode_M0_nil_nil_nonhalting : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1252,15 +1332,15 @@ theorem mode_M0_nil_nil_nonhalting : /-- Refined reachable stack subset for Holdout `#223`: canonical `evalStackCfg m L R` configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ -def ValidStack223 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def ValidStack223 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) -theorem validStack223_subset_isInStackSystem : +private theorem validStack223_subset_isInStackSystem : ∀ cfg, ValidStack223 cfg → IsInStackSystem cfg := by intro cfg ⟨m, L, R, hcfg, _⟩ exact ⟨m, L, R, hcfg⟩ -theorem init_reaches_validStack223 : +private theorem init_reaches_validStack223 : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack223 cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ @@ -1269,13 +1349,13 @@ theorem init_reaches_validStack223 : listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] execute 4 -theorem cfg_M0_nil_nil_reaches_validStack223 : +private theorem cfg_M0_nil_nil_reaches_validStack223 : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack223 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ -theorem stack_system_steps_to_validStack223 : +private theorem stack_system_steps_to_validStack223 : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack223 cfg' ∨ (step target_tm cfg').isNone) := by @@ -1294,7 +1374,7 @@ theorem stack_system_steps_to_validStack223 : Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ -theorem validStack223_step_closed : +private theorem validStack223_step_closed : ∀ cfg, ValidStack223 cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack223 cfg' ∨ (step target_tm cfg').isNone) := @@ -1303,7 +1383,7 @@ theorem validStack223_step_closed : /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` when `bR % 4 < 3`. -/ -theorem mode_M0_head_three_lt3_nonhalting +private theorem mode_M0_head_three_lt3_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ ValidStack223 cfg' := @@ -1313,7 +1393,7 @@ theorem mode_M0_head_three_lt3_nonhalting /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` when `bR % 4 = 3`. -/ -theorem mode_M0_head_three_eq3_nil_nonhalting +private theorem mode_M0_head_three_eq3_nil_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ ValidStack223 cfg' := @@ -1322,7 +1402,7 @@ theorem mode_M0_head_three_eq3_nil_nonhalting ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ /-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ -lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : +private theorem D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1334,7 +1414,7 @@ lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ -theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : +private theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ ValidStack223 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1342,7 +1422,7 @@ theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ /-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ -lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : +private theorem D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone = true := by unfold cfg_D @@ -1357,7 +1437,7 @@ lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : /-- Stage 2 halting counterexample family in `ValidStack223` (`R = []`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack223` and halts in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack223_M0_left_ge2_nil_halts +private theorem counterexample_validStack223_M0_left_ge2_nil_halts (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : ValidStack223 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ @@ -1369,7 +1449,7 @@ theorem counterexample_validStack223_M0_left_ge2_nil_halts /-- Stage 2 halting counterexample family in `ValidStack223` (`R = (0, bR) :: R'`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack223` and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack223_M0_left_ge2_zero_halts +private theorem counterexample_validStack223_M0_left_ge2_zero_halts (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : ValidStack223 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ @@ -1382,7 +1462,7 @@ theorem counterexample_validStack223_M0_left_ge2_zero_halts `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, and halts via `D_head_ge2_halts`. -/ -theorem counterexample_validStack223_M0_three_eq3_cons_halts +private theorem counterexample_validStack223_M0_three_eq3_cons_halts (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : ValidStack223 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')) ∧ diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean index 2f58f4da..2a2e103d 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,20 +45,20 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 1, Stmt.write 0 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -70,197 +66,209 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -299,7 +307,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -331,12 +339,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -348,94 +356,111 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 | F12 | F13 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) - | .F01, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F01, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F03, L'', W, R => (W +> wall L'') <{{B}} ((0 : Fin 2) >> encRight R) | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F06, L'', W, R => (W +> wall L'') <{{C}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F08, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => + (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F09, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) - | .F10, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F11, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) -- ============================================================================ -- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` -- ============================================================================ -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by +private theorem M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, + 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by have hb4 : bR % 4 + 1 < 4 := by omega rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_pushZeroSep _ hb4] have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] execute 6 -lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : +private theorem M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, + encTail_nil] execute 6 -lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by +private theorem M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : + ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, + 3) :: (d₂, b₂) :: R'') := by rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] execute 9 -lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by +private theorem M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, + bR) :: R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] execute 6 -theorem stage1_step (L R : List (ℕ × ℕ)) : +private theorem stage1_step (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -450,75 +475,80 @@ theorem stage1_step (L R : List (ℕ × ℕ)) : · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ - · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ - · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, + 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', + bR) :: R', rfl⟩⟩ -- ============================================================================ -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 3 -lemma D_leaf_10000 (tL rD : ListBlank (Fin 2)) : - (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ +private theorem D_leaf_10000 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 7 -lemma D_leaf_10001 (tL rD : ListBlank (Fin 2)) : - (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ - (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by +private theorem D_leaf_10001 (tL rD : ListBlank (Fin 2)) : + (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + tL) <{{D}} rD) [target_tm]⊢⁺ + (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + rD)) := by execute 7 -lemma D_leaf_1001 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_1001 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_101 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 5 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -527,7 +557,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp @@ -542,7 +573,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -563,72 +595,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -643,24 +698,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -668,7 +729,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -677,7 +739,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -686,7 +749,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 @@ -707,28 +771,36 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20] + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -742,56 +814,69 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : simpa using D_leaf_101 default rD · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_101 _ rD · -- a₂ = a₂' + 1 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((1, b₁) :: (a₂' + 1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_101 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD - · -- b₁ % 4 = 1 -> Leaf 1001 -> cfg_D 0 ((a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₁ % 4 = 1 -> Leaf 1001 -> cfg_D 0 ((a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight + -- R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, + b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 0 ((a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨0, (a₂, b₂) :: L'', (0, 0) :: (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨0, (a₂, b₂) :: L'', (0, 0) :: (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D rw [encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_1001 (encTail ((a₂, b₂) :: L'')) rD · -- b₁ % 4 = 2 -> Leaf 10001 -> cfg_D 3 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 3 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨3, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨3, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, + by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_10001 (encTail ((a₂, b₂) :: L'')) rD - · -- b₁ % 4 = 3 -> Leaf 10000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: tailAsRight R) + · -- b₁ % 4 = 3 -> Leaf 10000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) := by rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 1) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, encTail_zero 1 ((0, c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_10000 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) rD @@ -803,7 +888,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -831,32 +916,32 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) -- ============================================================================ -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ +private def C0 : FState → ℕ | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 2 | .F04 => 1 | .F05 => 0 | .F06 => 3 | .F07 => 1 | .F08 => 4 | .F09 => 2 | .F10 => 3 | .F11 => 3 | .F12 => 4 | .F13 => 4 -def C1 : FState → ℕ +private def C1 : FState → ℕ | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 1 | .F06 => 2 | .F07 => 0 | .F08 => 3 | .F09 => 3 | .F10 => 4 | .F11 => 4 | .F12 => 3 | .F13 => 5 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -864,7 +949,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -874,34 +959,35 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by rw [w_peelInner_zero b S h] rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -- Stage 3 P transitions -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -910,9 +996,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -920,7 +1007,7 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -929,9 +1016,10 @@ lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 3 -lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, + 0) :: peelInner b R_tail) := by unfold P_cfg rw [encRight_one_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -939,104 +1027,109 @@ lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 7 -lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : - (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by +private theorem P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : + List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, + b) :: R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail a b R_tail] execute 11 -- Stage 3 F transitions on bit 0 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 4 +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W R := by dsimp only [F_cfg]; execute 3 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 -lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 -lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -- Stage 3 F transitions on bit 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 -lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 1 +private theorem F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 3 +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F11 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -- Pushdown predicate & bit-step combinators -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -1044,16 +1137,21 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : Stage3Out start L'' W_out W_bound C1 := by cases s with | F00 => - exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => refine Or.inr ⟨.F03, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F02 => - have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + have hne : bumpHead R₁ ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F03 => - exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) @@ -1062,30 +1160,36 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ | F05 => - exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ | F06 => - exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ | F07 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F08 => refine Or.inr ⟨.F04, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F09 => - exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ | F10 => - exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ | F11 => refine Or.inr ⟨.F03, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F12 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F13 => refine Or.inr ⟨.F03, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -1102,7 +1206,8 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : | F01 => exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ | F02 => - exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ | F03 => have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega have h_p := stepPlus_trans h_reach (F03_bit1 L'' W_out R₁) @@ -1114,7 +1219,8 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F05 => - exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ | F06 => refine Or.inr ⟨.F09, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega @@ -1122,11 +1228,14 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F08 => - exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ | F09 => - exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ | F10 => - exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ | F11 => exact Or.inl ⟨F_cfg .F11 L'' (1 :: W_out) R₁, h_reach, F11_bit1_halt L'' W_out R₁⟩ | F12 => @@ -1135,7 +1244,7 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : | F13 => exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1242,50 +1351,72 @@ theorem stage3_ind (W_val : ℕ) : exact ⟨hQ0, hQz, hQz1⟩ -- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 2]; execute 6 -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, + encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 2]; execute 6 +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 1]; execute 5 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 1]; execute 5 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F06_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +private theorem F06_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F07_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F08_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 -lemma F09_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 +private theorem F09_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 -lemma F10_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +private theorem F10_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 -lemma F11_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 0]; execute 6 -lemma F12_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 -lemma F13_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 3]; execute 6 - -lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 +private theorem F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, + encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 0]; execute 6 +private theorem F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 +private theorem F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((0, 1) :: (0, + 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, + encRight_tailAsRight, encTail_zero 1, encRight_cons_simp 0 3]; execute 6 + +private theorem F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by cases s with | F00 => exact ⟨_, _, F00_exit L'' R⟩ @@ -1303,7 +1434,7 @@ lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : | F12 => exact ⟨_, _, F12_exit L'' R⟩ | F13 => exact ⟨_, _, F13_exit L'' R⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1316,7 +1447,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Closure & Main Theorem -- ============================================================================ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1334,11 +1465,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, @@ -1358,13 +1487,13 @@ theorem is_stack_cryptid : IsStackCryptid target_tm := by -- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield -- ============================================================================ -lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} +private theorem stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ -lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by @@ -1382,7 +1511,7 @@ lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ -lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by @@ -1399,7 +1528,8 @@ lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (ih (0 :: 0 :: 1 :: W)) /-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ -lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : + L_rest ≠ []) : (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ @@ -1421,7 +1551,7 @@ lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (h exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD /-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ -lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by induction k generalizing R with @@ -1444,7 +1574,7 @@ lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L (ih ((0, 2) :: tailAsRight R)) /-- Stage 2 empty-left-stack return to `cfg_M0`. -/ -lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1454,28 +1584,28 @@ lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ -theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ -theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ -theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ -theorem mode_M0_nil_nil_nonhalting : +private theorem mode_M0_nil_nil_nonhalting : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1484,15 +1614,15 @@ theorem mode_M0_nil_nil_nonhalting : /-- Refined reachable stack subset for Holdout `#325`: canonical `evalStackCfg m L R` configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ -def ValidStack325 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def ValidStack325 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) -theorem validStack325_subset_isInStackSystem : +private theorem validStack325_subset_isInStackSystem : ∀ cfg, ValidStack325 cfg → IsInStackSystem cfg := by intro cfg ⟨m, L, R, hcfg, _⟩ exact ⟨m, L, R, hcfg⟩ -theorem init_reaches_validStack325 : +private theorem init_reaches_validStack325 : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack325 cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ @@ -1501,13 +1631,13 @@ theorem init_reaches_validStack325 : listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] execute 4 -theorem cfg_M0_nil_nil_reaches_validStack325 : +private theorem cfg_M0_nil_nil_reaches_validStack325 : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack325 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ -theorem stack_system_steps_to_validStack325 : +private theorem stack_system_steps_to_validStack325 : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack325 cfg' ∨ (step target_tm cfg').isNone) := by @@ -1526,7 +1656,7 @@ theorem stack_system_steps_to_validStack325 : Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ -theorem validStack325_step_closed : +private theorem validStack325_step_closed : ∀ cfg, ValidStack325 cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack325 cfg' ∨ (step target_tm cfg').isNone) := @@ -1535,7 +1665,7 @@ theorem validStack325_step_closed : /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` when `bR % 4 < 3`. -/ -theorem mode_M0_head_three_lt3_nonhalting +private theorem mode_M0_head_three_lt3_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ ValidStack325 cfg' := @@ -1545,7 +1675,7 @@ theorem mode_M0_head_three_lt3_nonhalting /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` when `bR % 4 = 3`. -/ -theorem mode_M0_head_three_eq3_nil_nonhalting +private theorem mode_M0_head_three_eq3_nil_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ ValidStack325 cfg' := @@ -1554,7 +1684,7 @@ theorem mode_M0_head_three_eq3_nil_nonhalting ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ /-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ -lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : +private theorem D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1566,7 +1696,7 @@ lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ -theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : +private theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ ValidStack325 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1574,7 +1704,7 @@ theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ /-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ -lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : +private theorem D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone = true := by unfold cfg_D @@ -1589,7 +1719,7 @@ lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : /-- Stage 2 halting counterexample family in `ValidStack325` (`R = []`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack325` and halts in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack325_M0_left_ge2_nil_halts +private theorem counterexample_validStack325_M0_left_ge2_nil_halts (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : ValidStack325 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ @@ -1601,7 +1731,7 @@ theorem counterexample_validStack325_M0_left_ge2_nil_halts /-- Stage 2 halting counterexample family in `ValidStack325` (`R = (0, bR) :: R'`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack325` and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack325_M0_left_ge2_zero_halts +private theorem counterexample_validStack325_M0_left_ge2_zero_halts (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : ValidStack325 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ @@ -1614,7 +1744,7 @@ theorem counterexample_validStack325_M0_left_ge2_zero_halts `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, and halts via `D_head_ge2_halts`. -/ -theorem counterexample_validStack325_M0_three_eq3_cons_halts +private theorem counterexample_validStack325_M0_three_eq3_cons_halts (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : ValidStack325 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')) ∧ diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean index 6d433b25..e8d54baf 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,20 +45,20 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 4, Stmt.write 0 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -70,197 +66,209 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -299,7 +307,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -331,12 +339,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -348,94 +356,111 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 | F12 | F13 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) - | .F01, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F01, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F03, L'', W, R => (W +> wall L'') <{{B}} ((0 : Fin 2) >> encRight R) | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F06, L'', W, R => (W +> wall L'') <{{C}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F07, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F08, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F07, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => + (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F09, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) - | .F10, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F11, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) -- ============================================================================ -- Stage 1: `cfg_M0 L R` -> `cfg_M0` or `cfg_D 0` -- ============================================================================ -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by +private theorem M0_three_lt3 (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, + 0) :: tailAsRight L) (pushZeroSep (bR % 4 + 1) R') := by have hb4 : bR % 4 + 1 < 4 := by omega rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_pushZeroSep _ hb4] + encTail_zero bR, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, + encTail_pushZeroSep _ hb4] have hpow : 1 + (bR % 4 + 1) = 1 + (1 + bR % 4) := by omega rw [hpow, zero_pow_one_add (1 + bR % 4), listblank_append_cons] execute 6 -lemma M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : +private theorem M0_three_eq3_nil (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : (cfg_M0 L [(3, bR)]) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) [] := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, encTail_nil] + encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encRight_nil, + encTail_nil] execute 6 -lemma M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : ℕ) (R'' : List (ℕ × ℕ)) : - (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, 3) :: (d₂, b₂) :: R'') := by +private theorem M0_three_eq3_cons (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) (d₂ b₂ : + ℕ) (R'' : List (ℕ × ℕ)) : + (cfg_M0 L ((3, bR) :: (d₂, b₂) :: R'')) [target_tm]⊢⁺ cfg_D 0 ((0, 0) :: tailAsRight L) ((0, + 3) :: (d₂, b₂) :: R'') := by rw [cfg_M0_eq, cfg_D, encTail_succ 2, encTail_succ 1, encTail_succ 0, encTail_zero bR, hb, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 3] execute 9 -lemma M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : - (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R') := by +private theorem M0_add4 (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : + (cfg_M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, + bR) :: R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ (d + 3), encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, encTail_zero 0 ((d, bR) :: R'), encRight_cons_eq_one_cons_encTail] execute 6 -theorem stage1_step (L R : List (ℕ × ℕ)) : +private theorem stage1_step (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -450,70 +475,72 @@ theorem stage1_step (L R : List (ℕ × ℕ)) : · exact ⟨_, M0_three_lt3 L bR (by omega) R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, _, rfl⟩⟩ · rcases R' with _ | ⟨⟨d₂, b₂⟩, R''⟩ · exact ⟨_, M0_three_eq3_nil L bR h3, Or.inl ⟨.M0, (0, 0) :: tailAsRight L, [], rfl⟩⟩ - · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, 3) :: (d₂, b₂) :: R'', rfl⟩⟩ - · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', bR) :: R', rfl⟩⟩ + · exact ⟨_, M0_three_eq3_cons L bR h3 d₂ b₂ R'', Or.inr ⟨(0, 0) :: tailAsRight L, (0, + 3) :: (d₂, b₂) :: R'', rfl⟩⟩ + · exact ⟨_, M0_add4 L d' bR R', Or.inl ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d', + bR) :: R', rfl⟩⟩ -- ============================================================================ -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 3 -lemma D_leaf_1000 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_1000 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_1001 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_1001 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_101 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 3 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -522,7 +549,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp @@ -537,7 +565,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -558,72 +587,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -638,24 +690,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -663,7 +721,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -672,7 +731,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -681,7 +741,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 @@ -702,28 +763,36 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20] + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((1, b₁) :: (0, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_101 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -737,54 +806,67 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : simpa using D_leaf_101 default rD · have hL : encTail ((1, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_101 _ rD · -- a₂ = a₂' + 1 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((1, b₁) :: (a₂' + 1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_101 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 1001 -> cfg_D 2 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, + b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, + by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_1001 (encTail ((a₂, b₂) :: L'')) rD - · -- b₁ % 4 = 2 -> Leaf 1000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₁ % 4 = 2 -> Leaf 1000 -> cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₂, + b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_1000 (encRight ((a₂, b₂) :: L'')) rD - · -- b₁ % 4 = 3 -> Leaf 1000 -> cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₁ % 4 = 3 -> Leaf 1000 -> cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₂, b₂) :: L'')) := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₂, b₂) :: L'')) := by rw [encTail_succ, encTail_zero, hb3] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_1000 ((0 : Fin 2) >> encRight ((a₂, b₂) :: L'')) rD · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! @@ -795,7 +877,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -823,32 +905,32 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction (`P_cfg` and `F_cfg` -> `cfg_M0` or Halt) -- ============================================================================ -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ +private def C0 : FState → ℕ | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 2 | .F04 => 1 | .F05 => 0 | .F06 => 3 | .F07 => 1 | .F08 => 4 | .F09 => 2 | .F10 => 3 | .F11 => 3 | .F12 => 4 | .F13 => 4 -def C1 : FState → ℕ +private def C1 : FState → ℕ | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 1 | .F06 => 2 | .F07 => 0 | .F08 => 3 | .F09 => 3 | .F10 => 4 | .F11 => 4 | .F12 => 3 | .F13 => 5 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -856,7 +938,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -866,34 +948,35 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_one (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) + 1 = w ((1, b) :: S) := by rw [w_peelInner_zero b S h] rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_ge2 (a b : ℕ) (S : List (ℕ × ℕ)) : w ((0, 0) :: (a, b) :: S) + 2 = w ((a + 2, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -- Stage 3 P transitions -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -902,9 +985,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -912,7 +996,7 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -921,9 +1005,10 @@ lemma P_step_1_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 3 -lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((1, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (1 :: W) ((0, + 0) :: peelInner b R_tail) := by unfold P_cfg rw [encRight_one_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -931,104 +1016,109 @@ lemma P_step_1_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 7 -lemma P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : List (ℕ × ℕ)) : - (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, b) :: R_tail) := by +private theorem P_step_ge2 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (a b : ℕ) (R_tail : + List (ℕ × ℕ)) : + (P_cfg L'' W ((a + 2, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (a, + b) :: R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_succ (a + 1) b, encRight_succ a b, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail a b R_tail] execute 11 -- Stage 3 F transitions on bit 0 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 4 +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W R := by dsimp only [F_cfg]; execute 3 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 -lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 -lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -- Stage 3 F transitions on bit 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 1 -lemma F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 1 +private theorem F01_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F01 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : - (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : + (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by + dsimp only [F_cfg, P_cfg]; execute 3 +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F11 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -- Pushdown predicate & bit-step combinators -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -1036,16 +1126,21 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : Stage3Out start L'' W_out W_bound C1 := by cases s with | F00 => - exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F02 => - have hne : bumpHead R₁ ≠ [] := by rcases R₁ with _ | ⟨⟨a, b⟩, rs⟩; contradiction; simp [bumpHead] + have hne : bumpHead R₁ ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] refine Or.inr ⟨.F04, bumpHead R₁, hne, ?_, stepPlus_trans h_reach (F02_bit0 L'' W_out R₁)⟩ rw [w_bumpHead R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F03 => - exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hlt : w R₁ < W_bound := by dsimp [C0] at hw₁; omega have h_p := stepPlus_trans h_reach (F04_bit0 L'' W_out R₁) @@ -1054,30 +1149,36 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ | F05 => - exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ | F06 => - exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ | F07 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F08 => refine Or.inr ⟨.F04, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F09 => - exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ | F10 => - exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ | F11 => refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F12 => - refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, by simp, ?_, + stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 _ (by simp), w_cons_nonempty 0 1 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega | F13 => refine Or.inr ⟨.F00, (0, 3) :: R₁, by simp, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 3 R₁ hR₁]; dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -1094,7 +1195,8 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : | F01 => exact Or.inl ⟨F_cfg .F01 L'' (1 :: W_out) R₁, h_reach, F01_bit1_halt L'' W_out R₁⟩ | F02 => - exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ | F03 => have hlt : w R₁ < W_bound := by dsimp [C1] at hw₁; omega have h_p := stepPlus_trans h_reach (F03_bit1 L'' W_out R₁) @@ -1106,7 +1208,8 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F00, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F05 => - exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit1 L'' W_out R₁)⟩ | F06 => refine Or.inr ⟨.F09, (0, 0) :: R₁, by simp, ?_, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 0 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega @@ -1114,11 +1217,14 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F00, (0, 2) :: R₁, by simp, ?_, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ rw [w_cons_nonempty 0 2 R₁ hR₁]; dsimp [C1, C0] at hw₁ ⊢; omega | F08 => - exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ | F09 => - exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F09_bit1 L'' W_out R₁)⟩ | F10 => - exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ | F11 => exact Or.inl ⟨F_cfg .F11 L'' (1 :: W_out) R₁, h_reach, F11_bit1_halt L'' W_out R₁⟩ | F12 => @@ -1127,7 +1233,7 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : | F13 => exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1234,50 +1340,72 @@ theorem stage3_ind (W_val : ℕ) : exact ⟨hQ0, hQz, hQz1⟩ -- Stage 3 exit: `F_cfg s L'' [] R` -> `cfg_M0` -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 3 -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 3 +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 1]; execute 5 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 1]; execute 5 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F06_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 +private theorem F06_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F07_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F08_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 -lemma F09_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 +private theorem F09_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 -lemma F10_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 +private theorem F10_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 -lemma F11_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 3 -lemma F12_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 -lemma F13_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 3 - -lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 +private theorem F11_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 3 +private theorem F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 +private theorem F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 3 + +private theorem F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by cases s with | F00 => exact ⟨_, _, F00_exit L'' R⟩ @@ -1295,7 +1423,7 @@ lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : | F12 => exact ⟨_, _, F12_exit L'' R⟩ | F13 => exact ⟨_, _, F13_exit L'' R⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1308,7 +1436,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Closure & Main Theorem -- ============================================================================ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1326,11 +1454,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, @@ -1350,13 +1476,13 @@ theorem is_stack_cryptid : IsStackCryptid target_tm := by -- Wave 16: Multi-Step Contractions, Non-Halting Closures & Trajectory Shield -- ============================================================================ -lemma stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} +private theorem stepPlus_stepStar_trans {c₁ c₂ c₃ : Cfg (Fin 2) (Fin 6)} (h₁ : c₁ [target_tm]⊢⁺ c₂) (h₂ : c₂ [target_tm]⊢* c₃) : c₁ [target_tm]⊢* c₃ := stepPlus_stepStar (stepPlus_stepStar_stepPlus h₁ h₂) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(0, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 1` onto `W` `k` times. -/ -lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (0, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 1 :: w)^[k] W) R_tail := by @@ -1374,7 +1500,7 @@ lemma P_drain_0_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) /-- Multi-step Stage 3 pushdown contraction: draining `k` leading `(1, 0)` pairs in front of a non-empty tail `R_tail` pushes `0 :: 0 :: 1` onto `W` `k` times. -/ -lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) +private theorem P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W (List.replicate k (1, 0) ++ R_tail)) [target_tm]⊢* P_cfg L'' ((fun w => 0 :: 0 :: 1 :: w)^[k] W) R_tail := by @@ -1391,7 +1517,8 @@ lemma P_drain_1_rec_steps (k : ℕ) (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (ih (0 :: 0 :: 1 :: W)) /-- Single-step Stage 2 double-zero pop on `cfg_D`. -/ -lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (hL : + L_rest ≠ []) : (cfg_D c ((0, 0) :: (0, 0) :: L_rest) R) [target_tm]⊢⁺ cfg_D 2 L_rest ((0, c) :: tailAsRight R) := by rcases L_rest with _ | ⟨⟨a₃, b₃⟩, L'''⟩ @@ -1413,7 +1540,7 @@ lemma D_pop_double_zero (c : ℕ) (hc : c < 4) (L_rest R : List (ℕ × ℕ)) (h exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD /-- Multi-step Stage 2 contraction: draining `2 * k` leading `(0, 0)` pairs from `cfg_D 2`. -/ -lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : +private theorem D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L_rest ≠ []) : (cfg_D 2 (List.replicate (2 * k) (0, 0) ++ L_rest) R) [target_tm]⊢* cfg_D 2 L_rest ((fun r => (0, 2) :: tailAsRight r)^[k] R) := by induction k generalizing R with @@ -1436,7 +1563,7 @@ lemma D_drain_double_zero_steps (k : ℕ) (L_rest R : List (ℕ × ℕ)) (hL : L (ih ((0, 2) :: tailAsRight R)) /-- Stage 2 empty-left-stack return to `cfg_M0`. -/ -lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (cfg_D c [] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1446,28 +1573,28 @@ lemma D_nil_return (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((1, bR) :: R')`. -/ -theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_one_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) (peelSep bR R'), M0_one L bR R', ⟨.M0, (0, 0) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((2, bR) :: R')`. -/ -theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_two_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 1) :: tailAsRight L) (peelSep bR R'), M0_two L bR R', ⟨.M0, (0, 1) :: tailAsRight L, peelSep bR R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((d + 4, bR) :: R')`. -/ -theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem mode_M0_head_add4_nonhalting (L : List (ℕ × ℕ)) (d bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((d + 4, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 ((0, 0) :: tailAsRight L) ((0, 0) :: (d, bR) :: R'), M0_add4 L d bR R', ⟨.M0, (0, 0) :: tailAsRight L, (0, 0) :: (d, bR) :: R', rfl⟩⟩ /-- Unconditional non-halting mode closure for `evalStackCfg .M0 [] []`. -/ -theorem mode_M0_nil_nil_nonhalting : +private theorem mode_M0_nil_nil_nonhalting : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ IsInStackSystem cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1476,15 +1603,15 @@ theorem mode_M0_nil_nil_nonhalting : /-- Refined reachable stack subset for Holdout `#304`: canonical `evalStackCfg m L R` configurations with at least one non-empty stack (`L ≠ [] ∨ R ≠ []`). -/ -def ValidStack304 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def ValidStack304 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) -theorem validStack304_subset_isInStackSystem : +private theorem validStack304_subset_isInStackSystem : ∀ cfg, ValidStack304 cfg → IsInStackSystem cfg := by intro cfg ⟨m, L, R, hcfg, _⟩ exact ⟨m, L, R, hcfg⟩ -theorem init_reaches_validStack304 : +private theorem init_reaches_validStack304 : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ ValidStack304 cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl, Or.inr (by simp)⟩⟩ @@ -1493,13 +1620,13 @@ theorem init_reaches_validStack304 : listblank_append_nil, listblank_append_cons, encRight_nil, zero_cons_default] execute 4 -theorem cfg_M0_nil_nil_reaches_validStack304 : +private theorem cfg_M0_nil_nil_reaches_validStack304 : ∃ cfg', ((evalStackCfg .M0 [] []) [target_tm]⊢⁺ cfg') ∧ ValidStack304 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), stepPlus_trans (M0_nil []) (D_nil_return 0 (by decide) []), ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ -theorem stack_system_steps_to_validStack304 : +private theorem stack_system_steps_to_validStack304 : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack304 cfg' ∨ (step target_tm cfg').isNone) := by @@ -1518,7 +1645,7 @@ theorem stack_system_steps_to_validStack304 : Or.inl ⟨.M0, pL :: L', R, rfl, Or.inl (by simp)⟩⟩ · exact ⟨cfg₁, h₁, Or.inr hhalt⟩ -theorem validStack304_step_closed : +private theorem validStack304_step_closed : ∀ cfg, ValidStack304 cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (ValidStack304 cfg' ∨ (step target_tm cfg').isNone) := @@ -1527,7 +1654,7 @@ theorem validStack304_step_closed : /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L ((3, bR) :: R')` when `bR % 4 < 3`. -/ -theorem mode_M0_head_three_lt3_nonhalting +private theorem mode_M0_head_three_lt3_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 < 3) (R' : List (ℕ × ℕ)) : ∃ cfg', ((evalStackCfg .M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ ValidStack304 cfg' := @@ -1537,7 +1664,7 @@ theorem mode_M0_head_three_lt3_nonhalting /-- Unconditional non-halting mode closure for `evalStackCfg .M0 L [(3, bR)]` when `bR % 4 = 3`. -/ -theorem mode_M0_head_three_eq3_nil_nonhalting +private theorem mode_M0_head_three_eq3_nil_nonhalting (L : List (ℕ × ℕ)) (bR : ℕ) (hb : bR % 4 = 3) : ∃ cfg', ((evalStackCfg .M0 L [(3, bR)]) [target_tm]⊢⁺ cfg') ∧ ValidStack304 cfg' := @@ -1546,7 +1673,7 @@ theorem mode_M0_head_three_eq3_nil_nonhalting ⟨.M0, (0, 0) :: tailAsRight L, [], rfl, Or.inl (by simp)⟩⟩ /-- Stage 2 singleton-zero left-stack return to `cfg_M0`. -/ -lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : +private theorem D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ × ℕ)) : (cfg_D c [(0, b₁)] R) [target_tm]⊢⁺ cfg_M0 [] ((1, c) :: tailAsRight R) := by unfold cfg_D set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) @@ -1558,7 +1685,7 @@ lemma D_singleton_zero_return (c : ℕ) (hc : c < 4) (b₁ : ℕ) (R : List (ℕ exact D_leaf_00 (encTail []) rD /-- Unconditional non-halting turnaround closure for `evalStackCfg .M0 [(0, b₁)] []`. -/ -theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : +private theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ∃ cfg', ((evalStackCfg .M0 [(0, b₁)] []) [target_tm]⊢⁺ cfg') ∧ ValidStack304 cfg' := ⟨evalStackCfg .M0 [] ((1, 0) :: tailAsRight []), @@ -1566,7 +1693,7 @@ theorem mode_M0_singleton_zero_nil_nonhalting (b₁ : ℕ) : ⟨.M0, [], (1, 0) :: tailAsRight [], rfl, Or.inr (by simp)⟩⟩ /-- Stage 2 halting transition when `L` has head `a₁ ≥ 2`. -/ -lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : +private theorem D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c ((a₁' + 2, b₁) :: L') R) [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone = true := by unfold cfg_D @@ -1581,7 +1708,7 @@ lemma D_head_ge2_halts (c : ℕ) (a₁' b₁ : ℕ) (L' R : List (ℕ × ℕ)) : /-- Stage 2 halting counterexample family in `ValidStack304` (`R = []`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []` satisfies `ValidStack304` and halts in 4 steps via `M0_nil` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack304_M0_left_ge2_nil_halts +private theorem counterexample_validStack304_M0_left_ge2_nil_halts (a₁' b₁ : ℕ) (L' : List (ℕ × ℕ)) : ValidStack304 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') []) [target_tm]⊢⁺ cfg') ∧ @@ -1593,7 +1720,7 @@ theorem counterexample_validStack304_M0_left_ge2_nil_halts /-- Stage 2 halting counterexample family in `ValidStack304` (`R = (0, bR) :: R'`): any `evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')` satisfies `ValidStack304` and halts in 4 steps via `M0_zero` followed by `D_head_ge2_halts`. -/ -theorem counterexample_validStack304_M0_left_ge2_zero_halts +private theorem counterexample_validStack304_M0_left_ge2_zero_halts (a₁' b₁ bR : ℕ) (L' R' : List (ℕ × ℕ)) : ValidStack304 (evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) ∧ ∃ cfg', ((evalStackCfg .M0 ((a₁' + 2, b₁) :: L') ((0, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ @@ -1606,7 +1733,7 @@ theorem counterexample_validStack304_M0_left_ge2_zero_halts `evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')` enters Stage 2 via `M0_three_eq3_cons`, pops the leading `(0, 0), (0, 0)` pair via `D_pop_double_zero`, and halts via `D_head_ge2_halts`. -/ -theorem counterexample_validStack304_M0_three_eq3_cons_halts +private theorem counterexample_validStack304_M0_three_eq3_cons_halts (a₁' b₁ d₂ b₂ : ℕ) (L' R'' : List (ℕ × ℕ)) : ValidStack304 (evalStackCfg .M0 ((0, 0) :: (a₁' + 2, b₁) :: L') ((3, 3) :: (d₂, b₂) :: R'')) ∧ diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean index b7a1069c..2a3dc800 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,19 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 0 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -69,197 +65,209 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -298,7 +306,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -330,12 +338,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -347,80 +355,91 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 | F12 | F13 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F06, L'', W, R => (W +> wall L'') <{{A}} ((0 : Fin 2) >> encRight R) | .F07, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> encRight R) | .F08, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F09, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F10, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F11, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F12, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F13, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => + (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F12, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) + | .F13, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 5 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -429,7 +448,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp @@ -444,7 +464,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -465,72 +486,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -545,24 +589,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -570,7 +620,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -579,7 +630,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -588,7 +640,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 (for #14: F0 = 0LA) @@ -619,7 +672,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rfl rw [hL] refine ⟨cfg_D 3 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨3, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨3, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] @@ -658,73 +712,101 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩) · -- a₂ = a₂' + 1 have h1011 : ∀ (tL : ListBlank (Fin 2)), - (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by intro tL; execute 6 rcases a₂' with _ | a₂'' · -- a₂ = 1: split b₂ % 4 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h20]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using h1011 ((0 : Fin 2) >> encRight L'') · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h21]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h22]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ · have hL : encTail [(1, b₁), (1, b₂)] = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> default := by simp [encTail_succ, encTail_zero, hb0, h23] rw [hL] - refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ + refine ⟨cfg_M0 [] ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, + rfl⟩⟩ rw [cfg_M0_eq, encTail_nil, encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using h1011 default · have hL : encTail ((1, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((1, 0) :: (1, c) :: tailAsRight R), ?_, + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((1, 0) :: (1, + c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ have hpeel2 : ∀ (tL tP : ListBlank (Fin 2)), - (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by + (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL, + (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some A, ⟨0, tL, + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by intro tL tP; execute 4 - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encRight_cons_eq_one_cons_encTail, - encTail_succ 0, encTail_zero 0 ((1, c) :: tailAsRight R), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), + encRight_cons_eq_one_cons_encTail, + encTail_succ 0, encTail_zero 0 ((1, + c) :: tailAsRight R), encRight_cons_eq_one_cons_encTail, ← hrD_tail] exact stepPlus_trans - (h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L'''))) - (hpeel2 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) ((1 : Fin 2) >> rD)) + (h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail ((a₃, b₃) :: L'''))) + (hpeel2 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) ((1 : Fin 2) >> rD)) · -- a₂ = a₂'' + 2 have hL : encTail ((1, b₁) :: (a₂'' + 2, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> + encTail ((a₂'', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((a₂'', b₂) :: L''), encRight_cons_eq_one_cons_encTail, encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using h1011 ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) · -- b₁ % 4 = 1 have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by - rw [encTail_succ, encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail]; rfl + rw [encTail_succ, encTail_zero, hb1, encTail_succ, + encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using h100 (encTail ((a₂ + 1, b₂) :: L'')) · -- b₁ % 4 = 2 @@ -732,7 +814,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2, encTail_zero]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using h100 (encTail ((0, 0) :: (a₂, b₂) :: L'')) · -- b₁ % 4 = 3 @@ -740,7 +823,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb3, encTail_zero]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((0, 0) :: (0, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 0 ((0, c) :: tailAsRight R)] simpa [hrD_right] using h100 (encTail ((0, 1) :: (a₂, b₂) :: L'')) · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! @@ -751,7 +835,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -781,14 +865,14 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction & Universal Wipe Helpers -- ============================================================================ -lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : +private theorem zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by induction n with | zero => rfl | succ n' ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] -lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : +private theorem zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = (([0] : List (Fin 2)) ^ k) +> wall L := by induction k with @@ -798,59 +882,83 @@ lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] -lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), - (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ | 0, l, tR => by execute 3 | k + 1, l, tR => by - have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 1 have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR rw [zero_pow_append_zero (k + 1) l] at h2 exact stepPlus_trans h1 h2 -lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : - (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by - have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, + ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 2 have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 exact stepPlus_trans h1 h2 -lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep, encTail_zero] · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep b ((a, b') :: S')] -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ - | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 2 | .F07 => 0 | .F08 => 1 | .F09 => 1 | .F10 => 0 | .F11 => 1 | .F12 => 2 | .F13 => 2 - -def C1 : FState → ℕ - | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 0 | .F10 => 1 | .F11 => 2 | .F12 => 1 | .F13 => 1 - -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private def C0 : FState → ℕ + | .F00 => + 0 | .F01 => + 1 | .F02 => + 1 | .F03 => + 0 | .F04 => + 1 | .F05 => + 1 | .F06 => + 2 | .F07 => + 0 | .F08 => 1 | .F09 => 1 | .F10 => 0 | .F11 => 1 | .F12 => 2 | .F13 => 2 + +private def C1 : FState → ℕ + | .F00 => + 1 | .F01 => + 0 | .F02 => + 0 | .F03 => + 1 | .F04 => + 0 | .F05 => + 0 | .F06 => + 1 | .F07 => + 1 | .F08 => 2 | .F09 => 0 | .F10 => 1 | .F11 => 2 | .F12 => 1 | .F13 => 1 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -858,7 +966,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -868,26 +976,27 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -896,9 +1005,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -906,12 +1016,14 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : +private theorem P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : + List (ℕ × ℕ)) : (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ := by have henc : encRight ((k + 1, b) :: R_tail) = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> + encTail (peelSep b R_tail))) := by rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] unfold P_cfg @@ -920,112 +1032,112 @@ lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R rw [listblank_append_right_assoc, listblank_append_cons] exact hwipe -lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : +private theorem A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by execute 4 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 3 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 5 -lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F12 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 1]; execute 9 -lemma F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F13 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 7 -lemma F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F09 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F13 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F12_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F12 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 3) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 3]; execute 1 -lemma F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F13_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F13 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -1033,9 +1145,13 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : Stage3Out start L'' W_out W_bound C1 := by cases s with - | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega @@ -1046,13 +1162,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, + stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp @@ -1060,12 +1179,17 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F06, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F06 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F07, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F06_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F07 => exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ - | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F02, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ | F09 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega @@ -1076,13 +1200,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega refine Or.inr ⟨.F02, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F11 => exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ + | F11 => exact Or.inr ⟨.F12, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ | F12 => have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 1) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 1) :: R₁) = 0 + w ((0, 1) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 1) :: R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: (0, 1) :: R₁) = 0 + w ((0, 1) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 1) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 1) :: R₁, hne_1, ?_, + stepPlus_trans h_reach (F12_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F13 => have hne_0 : ((0, 3) :: R₁) ≠ [] := by simp @@ -1090,7 +1217,7 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F06, (0, 3) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F13_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -1104,29 +1231,38 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ | F02 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ - | F06 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ - | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F06 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ | F08 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F09 => exact Or.inl ⟨F_cfg .F09 L'' (1 :: W_out) R₁, h_reach, F09_bit1_halt L'' W_out R₁⟩ - | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ - | F11 => exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F11_bit1 L'' W_out R₁)⟩ + | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit1 L'' W_out R₁)⟩ + | F11 => exact Or.inr ⟨.F13, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F11_bit1 L'' W_out R₁)⟩ | F12 => have hne_0 : ((0, 3) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 3) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 3 (R₁) hR₁]; try omega @@ -1134,7 +1270,7 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : dsimp [C0, C1] at hw₁ ⊢; omega | F13 => exact Or.inl ⟨F_cfg .F13 L'' (1 :: W_out) R₁, h_reach, F13_bit1_halt L'' W_out R₁⟩ -lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} +private theorem step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → @@ -1158,7 +1294,7 @@ lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List ( · exact Or.inl ⟨cfg', g1, g2⟩ · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1211,16 +1347,19 @@ theorem stage3_ind (W_val : ℕ) : rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ · contradiction · unfold P_cfg at hpre ⊢ - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, + ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre have hw_tail : w R_tail + (k + 1) = W_val := by rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] have : b % 2 = 0 := by omega omega - rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : + List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ - · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : + w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · rw [hw_tail] at hw2 @@ -1233,16 +1372,19 @@ theorem stage3_ind (W_val : ℕ) : have hR1 : R1 ≠ [] := by simp [R1] have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by have hl := encRight_zero_peelInner b R_tail hcond - rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, + encTail_zero_eq_zero_cons_peelSep] at hl simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl - have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + have hpost : ⟨some A, ⟨0, + ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by unfold P_cfg rw [hz] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ · exact False.elim (peelInner_ne_nil b R_tail h_in) - · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((ai, bi) :: rsi) := by rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] rfl @@ -1259,7 +1401,8 @@ theorem stage3_ind (W_val : ℕ) : · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by have := C1_le_C0_succ s1 omega - rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : + (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega @@ -1278,63 +1421,86 @@ theorem stage3_ind (W_val : ℕ) : exact step_bit1 h1 hR1 hw1 ih_z exact ⟨hQ0, hQz, hQz1⟩ -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 - -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 - -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 - -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 + +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 - -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 - -lemma F05_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 1 - -lemma F06_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 4 - -lemma F07_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 + +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 2]; execute 1 + +private theorem F06_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 1, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 4 + +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0]; execute 1 -lemma F08_exit (L'' R : List (ℕ × ℕ)) : +private theorem F08_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 1]; execute 2 - -lemma F09_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 1 - -lemma F10_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 - -lemma F11_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 1]; execute 2 + +private theorem F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 0]; execute 1 + +private theorem F10_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: (0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_cons_simp 0 0]; execute 5 + +private theorem F11_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 - -lemma F12_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 - -lemma F13_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, 3) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 1 - -lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 3]; execute 1 + +private theorem F12_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F12 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 2) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 2]; execute 4 + +private theorem F13_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F13 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((0, 0) :: (0, + 3) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_zero 0, encRight_cons_simp 0 3]; execute 1 + +private theorem F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : ∃ L_out R_out, (F_cfg s L'' [] R) [target_tm]⊢⁺ cfg_M0 L_out R_out := by cases s with | F00 => exact ⟨_, _, F00_exit L'' R⟩ @@ -1352,7 +1518,7 @@ lemma F_exit_all (s : FState) (L'' R : List (ℕ × ℕ)) : | F12 => exact ⟨_, _, F12_exit L'' R⟩ | F13 => exact ⟨_, _, F13_exit L'' R⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1365,7 +1531,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt -- ============================================================================ -lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) +private theorem F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1385,7 +1551,7 @@ lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List ( | F12 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F12_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ | F13 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F13_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ -lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), +private theorem P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) @@ -1407,50 +1573,53 @@ lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List · exact ⟨cfg', h2, Or.inr h3⟩ · exact F_empty_closed s2 L'' R2 hR2 h2 -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 5 -lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 6 -lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 7 -lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by have htail : encTail ((k + 5, bR) :: R') = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> + encTail (peelSep bR R'))) := by rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] rw [cfg_M0_eq, htail] @@ -1458,7 +1627,7 @@ lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) rw [zero_pow_wall k L] at hw exact hw -lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hpre := M0_add5_pre L k bR R' @@ -1469,7 +1638,7 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by unfold P_cfg - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by @@ -1487,7 +1656,8 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, @@ -1501,10 +1671,13 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = - ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] @@ -1519,10 +1692,11 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, listblank_append_nil, listblank_append_cons] at hpre ⊢ - exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> + wall L) (encTail ((ai, bi) :: rsi))) exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 -theorem stage1_step_all (L R : List (ℕ × ℕ)) : +private theorem stage1_step_all (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -1538,7 +1712,7 @@ theorem stage1_step_all (L R : List (ℕ × ℕ)) : · exact ⟨cfg', h, Or.inl hM⟩ · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1557,11 +1731,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean index baedc86d..888d04fa 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,19 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 2, Stmt.write 0 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -69,204 +65,216 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by +private theorem mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by have := Nat.mod_lt b (by decide : 0 < 4) omega -def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a + 1, b) :: S -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -305,7 +313,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -337,12 +345,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -354,76 +362,83 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F06, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> encRight R) | .F07, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F08, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F09, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F08, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 5 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -432,7 +447,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp @@ -447,7 +463,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -468,72 +485,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -548,24 +588,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -573,7 +619,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -582,7 +629,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -591,7 +639,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 (for #49: F0 = 0LC -> ultra-short 3-step leaves!) @@ -612,32 +661,42 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] refine ⟨cfg_D 1 ((a₂, b₂) :: L'') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (0, c) :: tailAsRight R, by decide, + by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] execute 3 · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, + b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using h100 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using h100 ((0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 2) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using h100 ((0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! have hL : encTail ((a₁' + 2, b₁) :: L') = @@ -647,7 +706,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -677,14 +736,14 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction & Universal Wipe Helpers -- ============================================================================ -lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : +private theorem zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by induction n with | zero => rfl | succ n' ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] -lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : +private theorem zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = (([0] : List (Fin 2)) ^ k) +> wall L := by induction k with @@ -694,59 +753,73 @@ lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] -lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), - (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ | 0, l, tR => by execute 3 | k + 1, l, tR => by - have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 1 have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR rw [zero_pow_append_zero (k + 1) l] at h2 exact stepPlus_trans h1 h2 -lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : - (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by - have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, + ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 2 have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 exact stepPlus_trans h1 h2 -lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep, encTail_zero] · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep b ((a, b') :: S')] -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ - | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 2 +private def C0 : FState → ℕ + | .F00 => + 0 | .F01 => + 1 | .F02 => + 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 2 -def C1 : FState → ℕ - | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 2 | .F08 => 1 | .F09 => 1 +private def C1 : FState → ℕ + | .F00 => + 1 | .F01 => + 0 | .F02 => + 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 2 | .F08 => 1 | .F09 => 1 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -754,7 +827,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -764,26 +837,27 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -792,9 +866,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -802,12 +877,14 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : +private theorem P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : + List (ℕ × ℕ)) : (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ := by have henc : encRight ((k + 1, b) :: R_tail) = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> + encTail (peelSep b R_tail))) := by rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] unfold P_cfg @@ -816,88 +893,88 @@ lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R rw [listblank_append_right_assoc, listblank_append_cons] exact hwipe -lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : +private theorem A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by execute 4 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 1 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: bumpHead R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 -lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 -lemma F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F09 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -905,9 +982,13 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : Stage3Out start L'' W_out W_bound C1 := by cases s with - | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega @@ -918,13 +999,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, + stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp @@ -937,13 +1021,19 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : rcases _ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F07_bit0 L'' W_out R₁)⟩ | F08 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by + rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, + stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F09 => have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp @@ -951,7 +1041,7 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : refine Or.inr ⟨.F06, (0, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -965,21 +1055,25 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ | F02 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ - | F06 => exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ - | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F06 => exact Or.inr ⟨.F07, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ | F08 => have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega @@ -987,7 +1081,7 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : dsimp [C0, C1] at hw₁ ⊢; omega | F09 => exact Or.inl ⟨F_cfg .F09 L'' (1 :: W_out) R₁, h_reach, F09_bit1_halt L'' W_out R₁⟩ -lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} +private theorem step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → @@ -1011,7 +1105,7 @@ lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List ( · exact Or.inl ⟨cfg', g1, g2⟩ · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1064,16 +1158,19 @@ theorem stage3_ind (W_val : ℕ) : rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ · contradiction · unfold P_cfg at hpre ⊢ - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, + ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre have hw_tail : w R_tail + (k + 1) = W_val := by rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] have : b % 2 = 0 := by omega omega - rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : + List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ - · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : + w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · rw [hw_tail] at hw2 @@ -1086,16 +1183,19 @@ theorem stage3_ind (W_val : ℕ) : have hR1 : R1 ≠ [] := by simp [R1] have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by have hl := encRight_zero_peelInner b R_tail hcond - rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, + encTail_zero_eq_zero_cons_peelSep] at hl simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl - have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + have hpost : ⟨some A, ⟨0, + ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by unfold P_cfg rw [hz] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ · exact False.elim (peelInner_ne_nil b R_tail h_in) - · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((ai, bi) :: rsi) := by rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] rfl @@ -1112,7 +1212,8 @@ theorem stage3_ind (W_val : ℕ) : · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by have := C1_le_C0_succ s1 omega - rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : + (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega @@ -1131,47 +1232,60 @@ theorem stage3_ind (W_val : ℕ) : exact step_bit1 h1 hR1 hw1 ih_z exact ⟨hQ0, hQz, hQz1⟩ -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 - -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 - -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 - -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 + +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 2 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 2 -lemma F06_p_exit (L'' R : List (ℕ × ℕ)) : +private theorem F06_p_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ P_cfg L'' [] R := by dsimp only [F_cfg, P_cfg, wall]; rw [listblank_append_nil]; execute 1 -lemma F07_exit (L'' R : List (ℕ × ℕ)) : +private theorem F07_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 -lemma F08_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 +private theorem F08_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 -lemma F09_exit (L'' R : List (ℕ × ℕ)) : +private theorem F09_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((1, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 2 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 2 -lemma stage3_closed_aux (W_val : ℕ) : +private theorem stage3_closed_aux (W_val : ℕ) : ∀ L'' R, R ≠ [] → w R = W_val → ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1207,7 +1321,7 @@ lemma stage3_closed_aux (W_val : ℕ) : | F09 => exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F09_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := stage3_closed_aux (w R) L'' R hR rfl @@ -1216,7 +1330,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt -- ============================================================================ -lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) +private theorem F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1234,7 +1348,7 @@ lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List ( | F08 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F08_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ | F09 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F09_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ -lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), +private theorem P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) @@ -1256,50 +1370,53 @@ lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List · exact ⟨cfg', h2, Or.inr h3⟩ · exact F_empty_closed s2 L'' R2 hR2 h2 -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 5 -lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 6 -lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 7 -lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by have htail : encTail ((k + 5, bR) :: R') = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> + encTail (peelSep bR R'))) := by rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] rw [cfg_M0_eq, htail] @@ -1307,7 +1424,7 @@ lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) rw [zero_pow_wall k L] at hw exact hw -lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hpre := M0_add5_pre L k bR R' @@ -1318,7 +1435,7 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by unfold P_cfg - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by @@ -1336,7 +1453,8 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, @@ -1350,10 +1468,13 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = - ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] @@ -1368,10 +1489,11 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, listblank_append_nil, listblank_append_cons] at hpre ⊢ - exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> + wall L) (encTail ((ai, bi) :: rsi))) exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 -theorem stage1_step_all (L R : List (ℕ × ℕ)) : +private theorem stage1_step_all (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -1387,7 +1509,7 @@ theorem stage1_step_all (L R : List (ℕ × ℕ)) : · exact ⟨cfg', h, Or.inl hM⟩ · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1406,11 +1528,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean index 5af139ce..90103233 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,19 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -69,204 +65,216 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by +private theorem mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by have := Nat.mod_lt b (by decide : 0 < 4) omega -def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a + 1, b) :: S -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -305,7 +313,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -337,12 +345,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -354,73 +362,78 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F06, L'', W, R => (W +> wall L'') <{{A}} encRight R -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 5 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -429,7 +442,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R have hrD_one_right : (1 : Fin 2) >> (1 : Fin 2) >> rD = encRight ((1, c) :: tailAsRight R) := by rw [hrD_tail, ← encRight_cons_eq_one_cons_encTail] have hrD_two : (1 : Fin 2) >> (1 : Fin 2) >> rD = encTail ((2, c) :: tailAsRight R) := by @@ -448,7 +462,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -469,72 +484,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -549,24 +587,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -574,7 +618,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -583,7 +628,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -592,7 +638,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 (for #301: F0 = 1LA) @@ -623,7 +670,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((1, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (1, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (1, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] @@ -662,31 +710,41 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩) · -- a₂ = a₂' + 1 have h1011 : ∀ (tL : ListBlank (Fin 2)), - (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ + (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> + tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by intro tL; execute 6 rcases a₂' with _ | a₂'' · -- a₂ = 1: split b₂ % 4 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h20]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_two] simpa using h1011 ((0 : Fin 2) >> encRight L'') · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h21]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_two] simpa using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') · have hL : encTail ((1, b₁) :: (1, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22]; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ, encTail_zero, h22]; rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_two] simpa using h1011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ @@ -699,29 +757,37 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : simpa using h1011 default · have hL : encTail ((1, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((1, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (1, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (1, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_one_right] exact h1011 _ · -- a₂ = a₂'' + 2 have hL : encTail ((1, b₁) :: (a₂'' + 2, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) := by - rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl + (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> + encTail ((a₂'', b₂) :: L'')) := by + rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, + encTail_succ (a₂'' + 1), encTail_succ a₂'']; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂'', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + refine ⟨cfg_M0 ((0, 0) :: (a₂'', b₂) :: L'') ((2, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂'', b₂) :: L''), + encRight_cons_eq_one_cons_encTail, ← hrD_two] simpa using h1011 ((1 : Fin 2) >> encTail ((a₂'', b₂) :: L'')) · -- b₁ % 4 = 1 have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂ + 1, b₂) :: L'') := by - rw [encTail_succ, encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail]; rfl + rw [encTail_succ, encTail_zero, hb1, encTail_succ, + encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_two] exact h100 (encTail ((a₂ + 1, b₂) :: L'')) · -- b₁ % 4 = 2 @@ -729,7 +795,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 0) :: (a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2, encTail_zero]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_two] exact h100 (encTail ((0, 0) :: (a₂, b₂) :: L'')) · -- b₁ % 4 = 3 @@ -737,7 +804,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, 1) :: (a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb3, encTail_zero]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_two] exact h100 (encTail ((0, 1) :: (a₂, b₂) :: L'')) · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! @@ -748,7 +816,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -776,14 +844,14 @@ theorem stage2_closed (n : ℕ) : -- Stage 3: Pushdown Induction & Universal Wipe Helpers -- ============================================================================ -lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : +private theorem zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by induction n with | zero => rfl | succ n' ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] -lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : +private theorem zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = (([0] : List (Fin 2)) ^ k) +> wall L := by induction k with @@ -793,59 +861,67 @@ lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] -lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), - (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ | 0, l, tR => by execute 3 | k + 1, l, tR => by - have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 1 have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR rw [zero_pow_append_zero (k + 1) l] at h2 exact stepPlus_trans h1 h2 -lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : - (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by - have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, + ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 2 have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 exact stepPlus_trans h1 h2 -lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep, encTail_zero] · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep b ((a, b') :: S')] -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ +private def C0 : FState → ℕ | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 -def C1 : FState → ℕ +private def C1 : FState → ℕ | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 0 -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -853,7 +929,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -863,26 +939,27 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -891,9 +968,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -901,12 +979,14 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : +private theorem P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : + List (ℕ × ℕ)) : (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ := by have henc : encRight ((k + 1, b) :: R_tail) = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> + encTail (peelSep b R_tail))) := by rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] unfold P_cfg @@ -915,71 +995,71 @@ lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R rw [listblank_append_right_assoc, listblank_append_cons] exact hwipe -lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : +private theorem A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by execute 4 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W ((1, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 1 2]; execute 1 -lemma F06_eq_P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_eq_P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : F_cfg .F06 L'' (0 :: W) R = P_cfg L'' W R := by simp [F_cfg, P_cfg] -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) R := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W R := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W R := by dsimp only [F_cfg]; execute 1 -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -987,9 +1067,13 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : Stage3Out start L'' W_out W_bound C1 := by cases s with - | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega @@ -1000,13 +1084,16 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, + stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => have hne_0 : ((1, 2) :: R₁) ≠ [] := by simp @@ -1021,7 +1108,7 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_reach h1⟩ -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -1035,22 +1122,25 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ | F02 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 2) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F04_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega | F05 => exact Or.inl ⟨F_cfg .F05 L'' (1 :: W_out) R₁, h_reach, F05_bit1_halt L'' W_out R₁⟩ - | F06 => exact Or.inr ⟨.F00, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ + | F06 => exact Or.inr ⟨.F00, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F06_bit1 L'' W_out R₁)⟩ -lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} +private theorem step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → @@ -1074,7 +1164,7 @@ lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List ( · exact Or.inl ⟨cfg', g1, g2⟩ · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -1129,16 +1219,19 @@ theorem stage3_ind (W_val : ℕ) : rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ · contradiction · unfold P_cfg at hpre ⊢ - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, + ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre have hw_tail : w R_tail + (k + 1) = W_val := by rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] have : b % 2 = 0 := by omega omega - rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : + List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ - · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_0 ih_z1 with + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : + w R_tail + (k + 1) ≤ W_val) ih_0 ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · rw [hw_tail] at hw2 @@ -1151,16 +1244,19 @@ theorem stage3_ind (W_val : ℕ) : have hR1 : R1 ≠ [] := by simp [R1] have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by have hl := encRight_zero_peelInner b R_tail hcond - rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, + encTail_zero_eq_zero_cons_peelSep] at hl simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl - have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + have hpost : ⟨some A, ⟨0, + ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by unfold P_cfg rw [hz] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ · exact False.elim (peelInner_ne_nil b R_tail h_in) - · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((ai, bi) :: rsi) := by rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] rfl @@ -1177,7 +1273,8 @@ theorem stage3_ind (W_val : ℕ) : · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by have := C1_le_C0_succ s1 omega - rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_0 ih_z1 with + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : + (w R1 + 1) + k ≤ W_val) ih_0 ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega @@ -1196,37 +1293,46 @@ theorem stage3_ind (W_val : ℕ) : exact step_bit1 h1 hR1 hw1 ih_z exact ⟨hQ0, hQz, hQz1⟩ -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 - -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 - -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 - -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 + +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F06_exit_eq (L'' R : List (ℕ × ℕ)) : +private theorem F06_exit_eq (L'' R : List (ℕ × ℕ)) : F_cfg .F06 L'' [] R = cfg_M0 ((0, 3) :: tailAsRight L'') (rightAsTail R) := by dsimp only [F_cfg, wall] rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_rightAsTail] simp -lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) +private theorem F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1241,7 +1347,7 @@ lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List ( rw [F06_exit_eq] at h_reach exact ⟨cfg_M0 _ _, h_reach, Or.inl ⟨.M0, _, _, rfl⟩⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hQ0 : Q0 R := (stage3_ind (w R) R hR rfl).1 @@ -1253,7 +1359,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt -- ============================================================================ -lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), +private theorem P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) @@ -1275,50 +1381,53 @@ lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List · exact ⟨cfg', h2, Or.inr h3⟩ · exact F_empty_closed s2 L'' R2 hR2 h2 -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 5 -lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 6 -lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 7 -lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by have htail : encTail ((k + 5, bR) :: R') = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> + encTail (peelSep bR R'))) := by rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] rw [cfg_M0_eq, htail] @@ -1326,7 +1435,7 @@ lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) rw [zero_pow_wall k L] at hw exact hw -lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by have hpre := M0_add5_pre L k bR R' @@ -1337,7 +1446,7 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ · have hpost : (cfg_M0 L ((k + 5, bR) :: (a₂, b₂) :: R'')) [target_tm]⊢⁺ P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by unfold P_cfg - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by @@ -1355,7 +1464,8 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, @@ -1369,10 +1479,13 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = - ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] @@ -1387,10 +1500,11 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, listblank_append_nil, listblank_append_cons] at hpre ⊢ - exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> + wall L) (encTail ((ai, bi) :: rsi))) exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 -theorem stage1_step_all (L R : List (ℕ × ℕ)) : +private theorem stage1_step_all (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -1406,7 +1520,7 @@ theorem stage1_step_all (L R : List (ℕ × ℕ)) : · exact ⟨cfg', h, Or.inl hM⟩ · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1425,11 +1539,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean index 65b0ad03..73cb197a 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` — `is_stack_cryptid` (`IsStackCryptid target_tm`) +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` (`IsStackCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsStackCryptid` proof for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.left) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,19 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 4, Stmt.write 1 Dir.left) | 5, 1 => none --- END TRUSTED DEFINITIONS --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS - -def A : Fin 6 := 0 -def B : Fin 6 := 1 -def C : Fin 6 := 2 -def D : Fin 6 := 3 -def E : Fin 6 := 4 -def F : Fin 6 := 5 +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl +private def A : Fin 6 := 0 +private def B : Fin 6 := 1 +private def C : Fin 6 := 2 +private def D : Fin 6 := 3 +private def E : Fin 6 := 4 +private def F : Fin 6 := 5 open BusyBeaver.PairStack Counter -lemma zero_pow_one_add (n : ℕ) : +private theorem zero_pow_one_add (n : ℕ) : (([0] : List (Fin 2)) ^ (1 + n)) = (0 : Fin 2) :: (([0] : List (Fin 2)) ^ n) := by rw [Nat.add_comm 1 n, pow_succ_list, cons_append_list, nil_append_list] @@ -69,204 +65,216 @@ lemma zero_pow_one_add (n : ℕ) : -- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) -- ============================================================================ -def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encLeft : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (a, b) :: L => (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) + | (a, b) :: L => + (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) -def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) +private def encRight : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default - | (d, b) :: R => (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) - -def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail - -@[simp] lemma encLeft_nil : encLeft [] = default := rfl -@[simp] lemma encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : - encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl -@[simp] lemma encRight_nil : encRight [] = default := rfl -@[simp] lemma encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) := rfl - -lemma encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by + | (d, b) :: R => + (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R) + +private def encTail (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := (encRight S).tail + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (a b : ℕ) (L : List (ℕ × ℕ)) : + encLeft ((a, b) :: L) = (encLeft L <+ (([0] : List (Fin 2)) ^ (1 + b % 4))) <+ + (([1] : List (Fin 2)) ^ (1 * a + 1)) := rfl +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (([1] : List (Fin 2)) ^ (1 * d + 1)) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight R) := rfl + +private theorem encLeft_eq_encRight (S : List (ℕ × ℕ)) : encLeft S = encRight S := by induction S with | nil => rfl | cons p S' ih => rcases p with ⟨a, b⟩ simp only [encLeft, encRight, ih] -@[simp] lemma encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by +@[simp] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by rw [encLeft_eq_encRight]; rfl -lemma encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl -@[simp] lemma encTail_nil : encTail [] = default := rfl +@[simp] private theorem encTail_nil : encTail [] = default := rfl -lemma encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : - encRight ((d, b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by +private theorem encRight_cons_simp (d b : ℕ) (R : List (ℕ × ℕ)) : + encRight ((d, + b) :: R) = (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ d) +> + ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight R)) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm d 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem encRight_succ (d b : ℕ) (R : List (ℕ × ℕ)) : encRight ((d + 1, b) :: R) = (1 : Fin 2) >> encRight ((d, b) :: R) := by simp only [encRight_cons, Nat.one_mul] rw [Nat.add_comm (d + 1) 1, list_pow_add, listblank_append_right_assoc] rfl -lemma encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : - encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S) := by +private theorem encTail_cons (a b : ℕ) (S : List (ℕ × ℕ)) : + encTail ((a, b) :: S) = (([1] : List (Fin 2)) ^ a) +> ((([0] : List (Fin 2)) ^ (1 + b % 4)) +> + encRight S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encRight_cons_eq_one_cons_encTail (a b : ℕ) (S : List (ℕ × ℕ)) : encRight ((a, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (([0] : List (Fin 2)) ^ (1 + b % 4)) +> encRight S := by rw [encTail_cons]; rfl -lemma encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_succ (a b : ℕ) (S : List (ℕ × ℕ)) : encTail ((a + 1, b) :: S) = (1 : Fin 2) >> encTail ((a, b) :: S) := by unfold encTail rw [encRight_succ, Turing.ListBlank.tail_cons, encRight_cons_simp, Turing.ListBlank.tail_cons] -lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by +private theorem mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by have := Nat.mod_lt b (by decide : 0 < 4) omega -def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a + 1, b) :: S -def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a, b) :: S => (a, b) :: S -def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b) :: S => (a + 1, b) :: S -def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => (0, b) :: (a, b') :: S -def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelSep (k : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [] | (a, b') :: S => if k % 4 = 0 then (a + 1, b') :: S else (0, k % 4 - 1) :: (a, b') :: S -def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) +private def peelInner (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) | [] => [(0, 0)] | (a₂, b₂) :: rs => if b % 4 = 1 then (a₂ + 1, b₂) :: rs else if b % 4 = 2 then (0, 0) :: (a₂, b₂) :: rs else (0, 1) :: (a₂, b₂) :: rs -lemma encRight_bumpHead (S : List (ℕ × ℕ)) : +private theorem encRight_bumpHead (S : List (ℕ × ℕ)) : encRight (bumpHead S) = (1 : Fin 2) >> encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [bumpHead] · exact encRight_succ a b S' -lemma encRight_tailAsRight (S : List (ℕ × ℕ)) : +private theorem encRight_tailAsRight (S : List (ℕ × ℕ)) : encRight (tailAsRight S) = (1 : Fin 2) >> encTail S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · simp [tailAsRight] · exact encRight_cons_eq_one_cons_encTail a b S' -lemma encTail_rightAsTail (S : List (ℕ × ℕ)) : +private theorem encTail_rightAsTail (S : List (ℕ × ℕ)) : encTail (rightAsTail S) = encRight S := by rcases S with _ | ⟨⟨a, b⟩, S'⟩ · rfl · unfold encTail rightAsTail rw [encRight_succ, Turing.ListBlank.tail_cons] -lemma encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : +private theorem encTail_pushZeroSep (b : ℕ) (hb : b < 4) (S : List (ℕ × ℕ)) : encTail (pushZeroSep b S) = (([0] : List (Fin 2)) ^ (1 + b)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [pushZeroSep] · rw [pushZeroSep, encTail_zero, Nat.mod_eq_of_lt hb] -lemma encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_peelSep (k : ℕ) (S : List (ℕ × ℕ)) : encTail (peelSep k S) = (([0] : List (Fin 2)) ^ (k % 4)) +> encRight S := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep] · rcases mod4_cases k with h0 | h1 | h2 | h3 - · rw [peelSep, if_pos h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] + · rw [peelSep, ite_eq_left h0, h0, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · simp [peelSep, h1, encTail_zero] · simp [peelSep, h2, encTail_zero] · simp [peelSep, h3, encTail_zero] -lemma peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by +private theorem peelInner_ne_nil (b : ℕ) (S : List (ℕ × ℕ)) : peelInner b S ≠ [] := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner] · dsimp [peelInner] split_ifs <;> simp -lemma encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((0, b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_zero_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((0, + b) :: S) = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · simp [peelInner, encTail_zero] · rcases mod4_cases b with h0 | h1 | h2 | h3 · rcases h with hnil | hne · contradiction · exact False.elim (hne h0) - · rw [peelInner, if_pos h1, encRight_cons_simp 0 b, h1, encTail_succ, + · rw [peelInner, ite_eq_left h1, encRight_cons_simp 0 b, h1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl · have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2, encRight_cons_simp 0 b, h2, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_left h2, encRight_cons_simp 0 b, h2, encTail_zero] rfl · have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2, encRight_cons_simp 0 b, h3, encTail_zero] + rw [peelInner, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] rfl -lemma encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : - encRight ((1, b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail (peelInner b S) := by +private theorem encRight_one_peelInner (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : + encRight ((1, + b) :: S) = (1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + encTail (peelInner b S) := by rw [encRight_succ 0 b S, encRight_zero_peelInner b S h] -- ============================================================================ -- Stack System Definition & Witness Checks -- ============================================================================ -def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ -inductive StackMode +private inductive StackMode | M0 deriving DecidableEq -def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .M0, L, R => cfg_M0 L R -def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ m L R, cfg = evalStackCfg m L R -lemma cfg_M0_eq (L R : List (ℕ × ℕ)) : +private theorem cfg_M0_eq (L R : List (ℕ × ℕ)) : cfg_M0 L R = ⟨some A, ⟨0, encTail L, encTail R⟩⟩ := by simp [cfg_M0, encRight_tail] -lemma valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by +private theorem valid_stack_modes : IsValidStackModes encLeft encRight evalStackCfg := by intro m cases m with | M0 => exact ⟨A, .tail [], .tail [], by decide, by decide, Or.inl (fun _ _ => rfl)⟩ -theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : (encRight ((d, b) :: R)).head = 1 := by rw [encRight_cons_simp, Turing.ListBlank.head_cons] -theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : +private theorem audit_encLeft_head (a b : ℕ) (L : List (ℕ × ℕ)) : (encLeft ((a, b) :: L)).head = 1 := by rw [encLeft_eq_encRight] exact audit_encRight_head a b L -theorem audit_encRight_not_surjective : +private theorem audit_encRight_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ R : List (ℕ × ℕ), encRight R ≠ t := by - refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ + refine ⟨(1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> (1 : Fin 2) >> default, rfl, ?_⟩ intro R h rcases R with _ | ⟨⟨_ | d, b⟩, R'⟩ · have h1 := congrArg (fun s => s.head) h @@ -305,7 +313,7 @@ theorem audit_encRight_not_surjective : simp only [Turing.ListBlank.tail_cons, Turing.ListBlank.head_cons, audit_encRight_head] at hc contradiction -theorem audit_encLeft_not_surjective : +private theorem audit_encLeft_not_surjective : ∃ t : ListBlank (Fin 2), t.head = 1 ∧ ∀ L : List (ℕ × ℕ), encLeft L ≠ t := by obtain ⟨t, ht, hR⟩ := audit_encRight_not_surjective exact ⟨t, ht, fun L hL => hR L (by rwa [← encLeft_eq_encRight])⟩ @@ -337,12 +345,12 @@ macro "execute" n:num : tactic => `(tactic| ( iterate $n step finish)) -lemma F_halt_on_one (tL rD : ListBlank (Fin 2)) : +private theorem F_halt_on_one (tL rD : ListBlank (Fin 2)) : (step target_tm (((1 : Fin 2) >> tL) <{{F}} rD)).isNone = true := by unfold step simp only [Turing.ListBlank.head_cons, F, target_tm, Option.map_none, Option.isNone_none] -theorem init_reaches_stack_system : +private theorem init_reaches_stack_system : ∃ cfg₀, ((init []) [target_tm]⊢⁺ cfg₀) ∧ IsInStackSystem cfg₀ := by refine ⟨cfg_M0 [] [(1, 0), (0, 0)], ?_, ⟨.M0, [], [(1, 0), (0, 0)], rfl⟩⟩ rw [init_nil, cfg_M0_eq, encTail_nil, encTail_succ, encTail_zero, encRight_cons_simp] @@ -354,44 +362,54 @@ theorem init_reaches_stack_system : -- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) -- ============================================================================ -def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def cfg_D (c : ℕ) (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := (encTail L) <{{D}} ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) -def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := - (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L'' +private def wall (L'' : List (ℕ × ℕ)) : ListBlank (Fin 2) := + (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail L'' -def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := ⟨some A, ⟨0, W +> wall L'', encRight R⟩⟩ -inductive FState +private inductive FState | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 deriving DecidableEq -def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) +private def F_cfg : FState → List (ℕ × ℕ) → List (Fin 2) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) | .F00, L'', W, R => (W +> wall L'') <{{E}} ((0 : Fin 2) >> encRight R) | .F01, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) | .F02, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F03, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F04, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F05, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F06, L'', W, R => (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F03, L'', W, R => + (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F04, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F05, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F06, L'', W, R => + (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight R) | .F07, L'', W, R => (W +> wall L'') <{{C}} ((0 : Fin 2) >> encRight R) | .F08, L'', W, R => (W +> wall L'') <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F09, L'', W, R => (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F10, L'', W, R => (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) - | .F11, L'', W, R => (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F09, L'', W, R => + (W +> wall L'') <{{A}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F10, L'', W, R => + (W +> wall L'') <{{F}} ((1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) + | .F11, L'', W, R => + (W +> wall L'') <{{E}} ((1 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight R) -- Stage 3: Pushdown Induction & Universal Wipe Helpers -- ============================================================================ -lemma zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : +private theorem zero_pow_append_zero (n : ℕ) (r : ListBlank (Fin 2)) : (([0] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> r) = (([0] : List (Fin 2)) ^ (n + 1)) +> r := by induction n with | zero => rfl | succ n' ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih] -lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : +private theorem zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : (([0] : List (Fin 2)) ^ (k + 5)) +> ((1 : Fin 2) >> encTail L) = (([0] : List (Fin 2)) ^ k) +> wall L := by induction k with @@ -401,59 +419,77 @@ lemma zero_pow_wall (k : ℕ) (L : List (ℕ × ℕ)) : rw [hsucc, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons] -lemma E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), - (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem E_wipe_ones_right : ∀ (k : ℕ) (l tR : ListBlank (Fin 2)), + (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (k + 1)) +> l, tR⟩⟩ | 0, l, tR => by execute 3 | k + 1, l, tR => by - have h1 : (⟨some E, ⟨(1 : Fin 2), l, ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some E, ⟨(1 : Fin 2), l, + ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> l, + ((([1] : List (Fin 2)) ^ k) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 1 have h2 := E_wipe_ones_right k ((0 : Fin 2) >> l) tR rw [zero_pow_append_zero (k + 1) l] at h2 exact stepPlus_trans h1 h2 -lemma A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : - (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) +private theorem A_wipe_ones (n : ℕ) (tL tR : ListBlank (Fin 2)) : + (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ (n + 2)) +> ((1 : Fin 2) >> tL), tR⟩⟩ := by - have h1 : (⟨some A, ⟨0, tL, (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) - [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by + have h1 : (⟨some A, ⟨0, tL, + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (n + 1)) +> ((0 : Fin 2) >> + tR))⟩⟩ : Cfg (Fin 2) (Fin 6)) + [target_tm]⊢⁺ ⟨some E, ⟨(1 : Fin 2), (0 : Fin 2) >> (1 : Fin 2) >> tL, + ((([1] : List (Fin 2)) ^ n) +> ((0 : Fin 2) >> tR))⟩⟩ := by execute 2 have h2 := E_wipe_ones_right n ((0 : Fin 2) >> (1 : Fin 2) >> tL) tR rw [zero_pow_append_zero (n + 1) ((1 : Fin 2) >> tL)] at h2 exact stepPlus_trans h1 h2 -lemma encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : +private theorem encTail_zero_eq_zero_cons_peelSep (b : ℕ) (S : List (ℕ × ℕ)) : encTail ((0, b) :: S) = (0 : Fin 2) >> encTail (peelSep b S) := by rcases S with _ | ⟨⟨a, b'⟩, S'⟩ · simp [peelSep, encTail_zero] · rw [encTail_zero, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep b ((a, b') :: S')] -def w : List (ℕ × ℕ) → ℕ +private def w : List (ℕ × ℕ) → ℕ | [] => 0 | [(a, _)] => a | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) -def C0 : FState → ℕ - | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 2 | .F07 => 1 | .F08 => 1 | .F09 => 2 | .F10 => 2 | .F11 => 3 - -def C1 : FState → ℕ - | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 1 | .F10 => 1 | .F11 => 2 - -lemma C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by +private def C0 : FState → ℕ + | .F00 => + 0 | .F01 => + 1 | .F02 => + 1 | .F03 => + 0 | .F04 => + 1 | .F05 => 1 | .F06 => 2 | .F07 => 1 | .F08 => 1 | .F09 => 2 | .F10 => 2 | .F11 => 3 + +private def C1 : FState → ℕ + | .F00 => + 1 | .F01 => + 0 | .F02 => + 0 | .F03 => + 1 | .F04 => + 0 | .F05 => 0 | .F06 => 1 | .F07 => 1 | .F08 => 2 | .F09 => 1 | .F10 => 1 | .F11 => 2 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by cases s <;> decide -lemma C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by cases s <;> decide -lemma w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_cons_nonempty (a b : ℕ) (R : List (ℕ × ℕ)) (hR : R ≠ []) : w ((a, b) :: R) = a + b % 2 + w R := by rcases R with _ | ⟨r₂, rs⟩ · contradiction · rfl -lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : w (bumpHead R) = 1 + w R := by rcases R with _ | ⟨⟨a, b⟩, rs⟩ · contradiction @@ -461,7 +497,7 @@ lemma w_bumpHead (R : List (ℕ × ℕ)) (hR : R ≠ []) : · simp [bumpHead, w]; omega · simp [bumpHead, w]; omega -lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : +private theorem w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 ≠ 0) : w ((0, 0) :: peelInner b S) = w ((0, b) :: S) := by rcases S with _ | ⟨⟨a₂, b₂⟩, rs⟩ · rfl @@ -471,26 +507,27 @@ lemma w_peelInner_zero (b : ℕ) (S : List (ℕ × ℕ)) (h : S = [] ∨ b % 4 · exact False.elim (hne h0) · have hb2 : b % 2 = 1 := by omega have hne : ((a₂ + 1, b₂) :: rs) ≠ [] := by simp - rw [peelInner, if_pos h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] - have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := w_bumpHead ((a₂, b₂) :: rs) (by simp) + rw [peelInner, ite_eq_left h1, w_cons_nonempty 0 0 _ hne, w_cons_nonempty 0 b _ (by simp)] + have hbmp : w ((a₂ + 1, b₂) :: rs) = 1 + w ((a₂, b₂) :: rs) := + w_bumpHead ((a₂, b₂) :: rs) (by simp) rw [hbmp, hb2]; omega · have hb2 : b % 2 = 0 := by omega have h1 : b % 4 ≠ 1 := by omega - rw [peelInner, if_neg h1, if_pos h2] + rw [peelInner, ite_eq_right h1, ite_eq_left h2] simp [w, hb2] · have hb2 : b % 2 = 1 := by omega have h1 : b % 4 ≠ 1 := by omega have h2 : b % 4 ≠ 2 := by omega - rw [peelInner, if_neg h1, if_neg h2] + rw [peelInner, ite_eq_right h1, ite_eq_right h2] simp [w, hb2] -lemma w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : +private theorem w_add_ge1 (k b : ℕ) (S : List (ℕ × ℕ)) : w ((0, b) :: S) + (k + 1) = w ((k + 1, b) :: S) := by rcases S with _ | ⟨r₂, rs⟩ · simp [w] · simp [w]; omega -lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) +private theorem P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : b % 4 = 0) (R_tail : List (ℕ × ℕ)) (hR : R_tail ≠ []) : (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) R_tail := by rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ @@ -499,9 +536,10 @@ lemma P_step_0_rec (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (hb : rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] execute 4 -lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) +private theorem P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) (R_tail : List (ℕ × ℕ)) (h : R_tail = [] ∨ b % 4 ≠ 0) : - (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: peelInner b R_tail) := by + (P_cfg L'' W ((0, b) :: R_tail)) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, + 0) :: peelInner b R_tail) := by dsimp only [P_cfg, F_cfg] rw [encRight_zero_peelInner b R_tail h] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ @@ -509,12 +547,14 @@ lemma P_step_0_other (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (b : ℕ) · rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] execute 9 -lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : List (ℕ × ℕ)) : +private theorem P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R_tail : + List (ℕ × ℕ)) : (P_cfg L'' W ((k + 1, b) :: R_tail)) [target_tm]⊢⁺ ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ := by have henc : encRight ((k + 1, b) :: R_tail) = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> encTail (peelSep b R_tail))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 1)) +> ((0 : Fin 2) >> + encTail (peelSep b R_tail))) := by rw [encRight_cons_eq_one_cons_encTail (k + 1) b R_tail, encTail_cons (k + 1) b R_tail, zero_pow_one_add (b % 4), listblank_append_cons, ← encTail_peelSep] unfold P_cfg @@ -523,100 +563,100 @@ lemma P_step_ge1_pre (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (k b : ℕ) (R rw [listblank_append_right_assoc, listblank_append_cons] exact hwipe -lemma A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : +private theorem A_peel_two_zeros (tL_rest tP : ListBlank (Fin 2)) : (⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> tL_rest, (0 : Fin 2) >> tP⟩⟩ : Cfg (Fin 2) (Fin 6)) [target_tm]⊢⁺ ⟨some A, ⟨0, tL_rest, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tP⟩⟩ := by execute 4 -lemma F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F01 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F02 L'' W (bumpHead R) := by dsimp only [F_cfg]; rw [encRight_bumpHead]; execute 5 -lemma F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: 1 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 4 -lemma F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F04 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F05 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F06 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W ((1, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_succ 0 2, encRight_cons_simp 0 2]; execute 1 -lemma F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (0 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 1 -lemma F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F09 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: bumpHead R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 -lemma F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F10 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F11 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit0 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (0 :: W) R) [target_tm]⊢⁺ F_cfg .F07 L'' W ((1, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_succ 0 1, encRight_cons_simp 0 1]; execute 1 -lemma F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F00_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F00 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) (R) := by dsimp only [F_cfg, P_cfg]; execute 3 -lemma F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F01_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F01 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F03 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F02_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F02 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 0) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 0]; execute 1 -lemma F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F03_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F03 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F05 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F04_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F04 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 2) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 2]; execute 1 -lemma F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F05_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F05 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F06_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F06 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) ((0, 0) :: (0, 0) :: R) := by dsimp only [F_cfg, P_cfg]; rw [encRight_cons_simp 0 0, encRight_cons_simp 0 0]; execute 9 -lemma F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F07_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F07 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F08 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F08_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F08 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F10 L'' W (R) := by dsimp only [F_cfg]; execute 1 -lemma F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F09_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F09 L'' (1 :: W) R) [target_tm]⊢⁺ F_cfg .F00 L'' W ((0, 1) :: R) := by dsimp only [F_cfg]; rw [encRight_cons_simp 0 1]; execute 1 -lemma F10_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F10_bit1_halt (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (step target_tm (F_cfg .F10 L'' (1 :: W) R)).isNone = true := by dsimp only [F_cfg]; rw [listblank_append_cons]; exact F_halt_on_one _ _ -lemma F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : +private theorem F11_bit1 (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) : (F_cfg .F11 L'' (1 :: W) R) [target_tm]⊢⁺ P_cfg L'' (0 :: W) ((0, 0) :: bumpHead R) := by dsimp only [F_cfg, P_cfg]; rw [encRight_cons_simp 0 0, encRight_bumpHead]; execute 9 -def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) +private def Stage3Out (start : Cfg (Fin 2) (Fin 6)) (L'' : List (ℕ × ℕ)) (W_out : List (Fin 2)) (W_bound : ℕ) (C : FState → ℕ) : Prop := (∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (step target_tm cfg').isNone) ∨ (∃ s R_out, R_out ≠ [] ∧ w R_out + C s ≤ W_bound ∧ (start [target_tm]⊢⁺ F_cfg s L'' W_out R_out)) -def Q0 (R : List (ℕ × ℕ)) : Prop := +private def Q0 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 -def Qz (R : List (ℕ × ℕ)) : Prop := +private def Qz (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 -def Qz1 (R : List (ℕ × ℕ)) : Prop := +private def Qz1 (R : List (ℕ × ℕ)) : Prop := ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 -lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (0 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C0 s ≤ W_bound) @@ -624,9 +664,13 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : (ih_z1 : ∀ R', R' ≠ [] → w R' < W_bound → Qz1 R') : Stage3Out start L'' W_out W_bound C1 := by cases s with - | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ + | F00 => exact Or.inr ⟨.F01, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F00_bit0 L'' W_out R₁)⟩ | F01 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ refine Or.inr ⟨.F02, bumpHead R₁, hne_0, ?_, stepPlus_trans h_reach (F01_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega @@ -637,15 +681,19 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C1_le_C0_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F04, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit0 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: (0, 0) :: R₁, hne_1, ?_, + stepPlus_trans h_reach (F04_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F05 => exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ + | F05 => exact Or.inr ⟨.F06, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F05_bit0 L'' W_out R₁)⟩ | F06 => have hne_0 : ((1, 2) :: R₁) ≠ [] := by simp have hw_op_0 : w ((1, 2) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 1 2 (R₁) hR₁]; try omega @@ -657,22 +705,29 @@ lemma step_bit0 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : rcases _ih_z R₁ hR₁ hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · exact Or.inr ⟨s', R_out, hne, by dsimp [C0] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F08 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ + | F08 => exact Or.inr ⟨.F09, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F08_bit0 L'' W_out R₁)⟩ | F09 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega - refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by + rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + refine Or.inr ⟨.F00, (0, 0) :: bumpHead R₁, hne_1, ?_, + stepPlus_trans h_reach (F09_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ + | F10 => exact Or.inr ⟨.F11, R₁, hR₁, by dsimp [C0, C1] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F10_bit0 L'' W_out R₁)⟩ | F11 => have hne_0 : ((1, 1) :: R₁) ≠ [] := by simp have hw_op_0 : w ((1, 1) :: R₁) = 2 + w (R₁) := by rw [w_cons_nonempty 1 1 (R₁) hR₁]; try omega refine Or.inr ⟨.F07, (1, 1) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F11_bit0 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega -lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} +private theorem step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : List (Fin 2)} {W_bound : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)} (h_reach : start [target_tm]⊢⁺ F_cfg s L'' (1 :: W_out) R₁) (hR₁ : R₁ ≠ []) (hw₁ : w R₁ + C1 s ≤ W_bound) @@ -686,13 +741,15 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ + | F01 => exact Or.inr ⟨.F03, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F01_bit1 L'' W_out R₁)⟩ | F02 => have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega refine Or.inr ⟨.F00, (0, 0) :: R₁, hne_0, ?_, stepPlus_trans h_reach (F02_bit1 L'' W_out R₁)⟩ dsimp [C0, C1] at hw₁ ⊢; omega - | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ + | F03 => exact Or.inr ⟨.F05, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F03_bit1 L'' W_out R₁)⟩ | F04 => have hne_0 : ((0, 2) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 2) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 2 (R₁) hR₁]; try omega @@ -703,15 +760,19 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : have hne_0 : ((0, 0) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 0) :: R₁) = 0 + w (R₁) := by rw [w_cons_nonempty 0 0 (R₁) hR₁]; try omega have hne_1 : ((0, 0) :: (0, 0) :: R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega + have hw_op_1 : w ((0, 0) :: (0, 0) :: R₁) = 0 + w ((0, 0) :: R₁) := by + rw [w_cons_nonempty 0 0 ((0, 0) :: R₁) hne_0]; try omega have hlt : w ((0, 0) :: (0, 0) :: R₁) < W_bound := by dsimp [C1] at hw₁; omega have h_p := stepPlus_trans h_reach (F06_bit1 L'' W_out R₁) - rcases ih_z ((0, 0) :: (0, 0) :: R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + rcases ih_z ((0, 0) :: (0, 0) :: R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, + hne, hw_out, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ - | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ - | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ + | F07 => exact Or.inr ⟨.F08, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F07_bit1 L'' W_out R₁)⟩ + | F08 => exact Or.inr ⟨.F10, R₁, hR₁, by dsimp [C1, C0] at hw₁ ⊢; omega, + stepPlus_trans h_reach (F08_bit1 L'' W_out R₁)⟩ | F09 => have hne_0 : ((0, 1) :: R₁) ≠ [] := by simp have hw_op_0 : w ((0, 1) :: R₁) = 1 + w (R₁) := by rw [w_cons_nonempty 0 1 (R₁) hR₁]; try omega @@ -719,18 +780,23 @@ lemma step_bit1 {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_out : dsimp [C0, C1] at hw₁ ⊢; omega | F10 => exact Or.inl ⟨F_cfg .F10 L'' (1 :: W_out) R₁, h_reach, F10_bit1_halt L'' W_out R₁⟩ | F11 => - have hne_0 : (bumpHead R₁) ≠ [] := by rcases R₁ with _ | ⟨⟨_, _⟩, _⟩; exact False.elim (hR₁ rfl); simp [bumpHead] + have hne_0 : (bumpHead R₁) ≠ [] := by + rcases R₁ with _ | ⟨_, _⟩ + · exact False.elim (hR₁ rfl) + · simp [bumpHead] have hw_op_0 : w (bumpHead R₁) = 1 + w (R₁) := w_bumpHead (R₁) hR₁ have hne_1 : ((0, 0) :: bumpHead R₁) ≠ [] := by simp - have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega + have hw_op_1 : w ((0, 0) :: bumpHead R₁) = 0 + w (bumpHead R₁) := by + rw [w_cons_nonempty 0 0 (bumpHead R₁) hne_0]; try omega have hlt : w ((0, 0) :: bumpHead R₁) < W_bound := by dsimp [C1] at hw₁; omega have h_p := stepPlus_trans h_reach (F11_bit1 L'' W_out R₁) - rcases ih_z ((0, 0) :: bumpHead R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, hne, hw_out, h1⟩ + rcases ih_z ((0, 0) :: bumpHead R₁) hne_1 hlt L'' W_out with ⟨cfg', h1, h2⟩ | ⟨s', R_out, + hne, hw_out, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ · have hc := C0_le_C1_succ s' exact Or.inr ⟨s', R_out, hne, by dsimp [C1] at hw₁; omega, stepPlus_trans h_p h1⟩ -lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} +private theorem step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List (ℕ × ℕ)} {W_rest : List (Fin 2)} {B W_max : ℕ} {s : FState} {R₁ : List (ℕ × ℕ)}, (start [target_tm]⊢⁺ F_cfg s L'' ((([0] : List (Fin 2)) ^ m) ++ W_rest) R₁) → R₁ ≠ [] → w R₁ + C1 s ≤ B → B + m ≤ W_max → @@ -754,7 +820,7 @@ lemma step_zeros_c1 : ∀ (m : ℕ) {start : Cfg (Fin 2) (Fin 6)} {L'' : List ( · exact Or.inl ⟨cfg', g1, g2⟩ · exact Or.inr ⟨sf, Rf, hRf, by omega, g1⟩ -theorem stage3_ind (W_val : ℕ) : +private theorem stage3_ind (W_val : ℕ) : ∀ R, R ≠ [] → w R = W_val → Q0 R ∧ Qz R ∧ Qz1 R := by induction W_val using Nat.strong_induction_on with | h W_val ih_w => @@ -807,16 +873,19 @@ theorem stage3_ind (W_val : ℕ) : rcases R_tail with _ | ⟨⟨a₂, b₂⟩, rs⟩ · contradiction · unfold P_cfg at hpre ⊢ - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, + ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre have hw_tail : w R_tail + (k + 1) = W_val := by rw [← hw_ab, ← w_add_ge1 k b R_tail, w_cons_nonempty 0 b R_tail hne_tail] have : b % 2 = 0 := by omega omega - rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with + rcases ih_z R_tail hne_tail (by omega) L'' ((([0] : + List (Fin 2)) ^ (k + 1)) ++ (1 :: W_base)) with ⟨cfg', h1, h2⟩ | ⟨s1, R1, hR1, hw1, h1⟩ · exact Or.inl ⟨cfg', stepPlus_trans h_p h1, h2⟩ - · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with + · rcases step_zeros_c1 (k + 1) (stepPlus_trans h_p h1) hR1 hw1 (by omega : + w R_tail + (k + 1) ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R2, hR2, hw2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · rw [hw_tail] at hw2 @@ -829,16 +898,19 @@ theorem stage3_ind (W_val : ℕ) : have hR1 : R1 ≠ [] := by simp [R1] have hz : encTail (peelSep b R_tail) = (0 : Fin 2) >> encTail (peelInner b R_tail) := by have hl := encRight_zero_peelInner b R_tail hcond - rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, encTail_zero_eq_zero_cons_peelSep] at hl + rw [encRight_cons_eq_one_cons_encTail 0 b R_tail, + encTail_zero_eq_zero_cons_peelSep] at hl simpa only [Turing.ListBlank.tail_cons] using congrArg (fun t => t.tail.tail) hl - have hpost : ⟨some A, ⟨0, ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', + have hpost : ⟨some A, ⟨0, + ((([0] : List (Fin 2)) ^ (k + 2)) ++ (1 :: W_base)) +> wall L'', encTail (peelSep b R_tail)⟩⟩ [target_tm]⊢⁺ P_cfg L'' ((([0] : List (Fin 2)) ^ k) ++ (1 :: W_base)) R1 := by unfold P_cfg rw [hz] rcases h_in : peelInner b R_tail with _ | ⟨⟨ai, bi⟩, rsi⟩ · exact False.elim (peelInner_ne_nil b R_tail h_in) - · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi) := by + · have hr1 : encRight R1 = (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((ai, bi) :: rsi) := by rw [show R1 = (0, 0) :: (ai, bi) :: rsi from congrArg ((0, 0) :: ·) h_in, encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail] rfl @@ -855,7 +927,8 @@ theorem stage3_ind (W_val : ℕ) : · have hc1 : w R_out1 + C1 s1 ≤ w R1 + 1 := by have := C1_le_C0_succ s1 omega - rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with + rcases step_zeros_c1 k (stepPlus_trans h_p h1) hne1 hc1 (by omega : + (w R1 + 1) + k ≤ W_val) ih_z ih_z1 with ⟨cfg', h2, h3⟩ | ⟨s2, R_out2, hne2, hw_out2, h2⟩ · exact Or.inl ⟨cfg', h2, h3⟩ · have hw2 : w R_out2 + C1 s2 ≤ W_val := by omega @@ -874,55 +947,70 @@ theorem stage3_ind (W_val : ℕ) : exact step_bit1 h1 hR1 hw1 ih_z exact ⟨hQ0, hQz, hQz1⟩ -lemma F00_exit (L'' R : List (ℕ × ℕ)) : +private theorem F00_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F00 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_zero 0]; execute 2 - -lemma F01_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 0) :: bumpHead R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 - -lemma F02_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') (rightAsTail R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 - -lemma F03_exit (L'' R : List (ℕ × ℕ)) : + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_zero 0]; execute 2 + +private theorem F01_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F01 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, + 0) :: bumpHead R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 0, encRight_bumpHead]; execute 5 + +private theorem F02_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F02 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, + 3) :: tailAsRight L'') (rightAsTail R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_rightAsTail]; execute 4 + +private theorem F03_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F03 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 2]; execute 1 -lemma F04_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 +private theorem F04_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F04 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 1) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 1]; execute 4 -lemma F05_exit (L'' R : List (ℕ × ℕ)) : +private theorem F05_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F05 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 3 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 3 -lemma F06_exit (L'' R : List (ℕ × ℕ)) : +private theorem F06_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F06 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((2, 2) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 2 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 2]; execute 2 -lemma F07_p_exit (L'' R : List (ℕ × ℕ)) : +private theorem F07_p_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F07 L'' [] R) [target_tm]⊢⁺ P_cfg L'' [] R := by dsimp only [F_cfg, P_cfg, wall]; rw [listblank_append_nil]; execute 1 -lemma F08_exit (L'' R : List (ℕ × ℕ)) : +private theorem F08_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F08 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((1, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 0, encTail_zero 1]; execute 1 -lemma F09_exit (L'' R : List (ℕ × ℕ)) : - (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, 0) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 +private theorem F09_exit (L'' R : List (ℕ × ℕ)) : + (F_cfg .F09 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: (0, 3) :: tailAsRight L'') ((0, + 0) :: R) := by + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 0, + encRight_cons_simp 0 3, encRight_tailAsRight, encTail_zero 0]; execute 4 -lemma F10_exit (L'' R : List (ℕ × ℕ)) : +private theorem F10_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F10 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L'') ((2, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 3 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 2, + encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 3 -lemma F11_exit (L'' R : List (ℕ × ℕ)) : +private theorem F11_exit (L'' R : List (ℕ × ℕ)) : (F_cfg .F11 L'' [] R) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L'') ((2, 1) :: R) := by - dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 2 + dsimp only [F_cfg, wall]; rw [cfg_M0_eq, listblank_append_nil, encTail_zero 3, + encRight_tailAsRight, encTail_succ 1, encTail_succ 0, encTail_zero 1]; execute 2 -lemma stage3_closed_aux (W_val : ℕ) : +private theorem stage3_closed_aux (W_val : ℕ) : ∀ L'' R, R ≠ [] → w R = W_val → ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -962,7 +1050,7 @@ lemma stage3_closed_aux (W_val : ℕ) : | F11 => exact ⟨cfg_M0 _ _, stepPlus_trans h1 (F11_exit L'' R_out), Or.inl ⟨.M0, _, _, rfl⟩⟩ -theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : +private theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : ∃ cfg', ((P_cfg L'' [] R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := stage3_closed_aux (w R) L'' R hR rfl @@ -971,7 +1059,7 @@ theorem stage3_closed (L'' R : List (ℕ × ℕ)) (hR : R ≠ []) : -- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt -- ============================================================================ -lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) +private theorem F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List (ℕ × ℕ)) (_hR : R ≠ []) (h_reach : start [target_tm]⊢⁺ F_cfg s L'' [] R) : ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -991,7 +1079,7 @@ lemma F_empty_closed {start : Cfg (Fin 2) (Fin 6)} (s : FState) (L'' R : List ( | F10 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F10_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ | F11 => exact ⟨cfg_M0 _ _, stepPlus_trans h_reach (F11_exit L'' R), Or.inl ⟨.M0, _, _, rfl⟩⟩ -lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), +private theorem P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List (ℕ × ℕ)), R ≠ [] → (start [target_tm]⊢⁺ P_cfg L'' (([0] : List (Fin 2)) ^ k) R) → ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) @@ -1013,50 +1101,53 @@ lemma P_drain_zeros : ∀ (k : ℕ) {start : Cfg (Fin 2) (Fin 6)} (L'' R : List · exact ⟨cfg', h2, Or.inr h3⟩ · exact F_empty_closed s2 L'' R2 hR2 h2 -lemma M0_nil (L : List (ℕ × ℕ)) : +private theorem M0_nil (L : List (ℕ × ℕ)) : (cfg_M0 L []) [target_tm]⊢⁺ cfg_D 0 L [] := by rw [cfg_M0_eq, cfg_D, encTail_nil] execute 3 -lemma M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_zero (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((0, bR) :: R')) [target_tm]⊢⁺ cfg_D 0 L (peelSep bR R') := by rw [cfg_M0_eq, cfg_D, encTail_zero, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 3 -lemma M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_one (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((1, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 0) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ, encTail_zero, encTail_zero 0 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 4 -lemma M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_two (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((2, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 1) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 1, encTail_succ 0, encTail_zero bR, encTail_zero 1 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 5 -lemma M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_three (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((3, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 2) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 2 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 6 -lemma M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_four (L : List (ℕ × ℕ)) (bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((4, bR) :: R')) [target_tm]⊢⁺ cfg_M0 ((0, 3) :: tailAsRight L) (peelSep bR R') := by rw [cfg_M0_eq, cfg_M0_eq, encTail_succ 3, encTail_succ 2, encTail_succ 1, encTail_succ 0, - encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, zero_pow_one_add (bR % 4), + encTail_zero bR, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, + zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] execute 7 -lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : (cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩ := by have htail : encTail ((k + 5, bR) :: R') = - (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> encTail (peelSep bR R'))) := by + (1 : Fin 2) >> ((([1] : List (Fin 2)) ^ (k + 4)) +> ((0 : Fin 2) >> + encTail (peelSep bR R'))) := by rw [encTail_succ (k + 4), encTail_cons (k + 4) bR R', zero_pow_one_add (bR % 4), listblank_append_cons, ← encTail_peelSep] rw [cfg_M0_eq, htail] @@ -1064,8 +1155,10 @@ lemma M0_add5_pre (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) rw [zero_pow_wall k L] at hw exact hw -lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) - (hpre : start [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, encTail (peelSep bR R')⟩⟩) : +private theorem A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ)) (k bR : + ℕ) (R' : List (ℕ × ℕ)) + (hpre : start [target_tm]⊢⁺ ⟨some A, ⟨0, (([0] : List (Fin 2)) ^ k) +> wall L, + encTail (peelSep bR R')⟩⟩) : ∃ cfg', (start [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by by_cases h_rec : R' ≠ [] ∧ bR % 4 = 0 @@ -1075,7 +1168,7 @@ lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ) · have hpost : start [target_tm]⊢⁺ P_cfg L (([0] : List (Fin 2)) ^ k) ((a₂, b₂) :: R'') := by unfold P_cfg - rw [peelSep, if_pos hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre + rw [peelSep, ite_eq_left hb0, encTail_succ, ← encRight_cons_eq_one_cons_encTail] at hpre exact hpre exact P_drain_zeros k L ((a₂, b₂) :: R'') (by simp) hpost · have hcond : R' = [] ∨ bR % 4 ≠ 0 := by @@ -1092,7 +1185,8 @@ lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ) · refine ⟨cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 2) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, @@ -1105,10 +1199,13 @@ lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ) · refine ⟨cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [hz, h_in] at hpre - have hp2 := A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L) + have hp2 := + A_peel_two_zeros ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L) (encTail ((ai, bi) :: rsi)) have hrhs : cfg_M0 ((0, 3) :: tailAsRight L) ((1, 0) :: (ai, bi) :: rsi) = - ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail L, + ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail L, (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((ai, bi) :: rsi)⟩⟩ := by rw [cfg_M0_eq, encTail_zero 3 (tailAsRight L), encRight_tailAsRight, encTail_succ 0, encTail_zero 0 ((ai, bi) :: rsi), encRight_cons_eq_one_cons_encTail] @@ -1122,10 +1219,11 @@ lemma A_wall_peelSep_closed {start : Cfg (Fin 2) (Fin 6)} (L : List (ℕ × ℕ) rw [encRight_cons_simp 0 0, encRight_cons_eq_one_cons_encTail ai bi rsi] dsimp only [pow_zero_list, pow_succ_list, nil_append_list, cons_append_list, listblank_append_nil, listblank_append_cons] at hpre ⊢ - exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> wall L) (encTail ((ai, bi) :: rsi))) + exact stepPlus_trans hpre (A_peel_two_zeros ((([0] : List (Fin 2)) ^ k') +> + wall L) (encTail ((ai, bi) :: rsi))) exact P_drain_zeros k' L ((0, 0) :: (ai, bi) :: rsi) (by simp) hp2 -lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : +private theorem M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L ((k + 5, bR) :: R')) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := A_wall_peelSep_closed L k bR R' (M0_add5_pre L k bR R') @@ -1133,59 +1231,59 @@ lemma M0_add5_closed (L : List (ℕ × ℕ)) (k bR : ℕ) (R' : List (ℕ × ℕ -- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` -- ============================================================================ -lemma RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encRight (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encRight ((0, c) :: tailAsRight R) := by rw [encRight_cons_simp, Nat.mod_eq_of_lt hc, encRight_tailAsRight] rfl -lemma RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_one (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((1, c) :: tailAsRight R) := by rw [encTail_succ, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem one_cons_RD_eq (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := by rw [encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma RD_eq_encTail_two (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem RD_eq_encTail_two (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (1 : Fin 2) >> (1 : Fin 2) >> ((([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R)) = encTail ((2, c) :: tailAsRight R) := by rw [encTail_succ 1, encTail_succ 0, encTail_zero, Nat.mod_eq_of_lt hc, encRight_tailAsRight] -lemma rD_eq_zero_cons_peelSep (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : +private theorem rD_eq_zero_cons_peelSep (c : ℕ) (hc : c < 4) (R : List (ℕ × ℕ)) : (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) = (0 : Fin 2) >> encTail (peelSep c (tailAsRight R)) := by rw [encTail_peelSep c (tailAsRight R), Nat.mod_eq_of_lt hc, encRight_tailAsRight, zero_pow_one_add c, listblank_append_cons] -lemma D_leaf_00 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_00 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, tL, (1 : Fin 2) >> rD⟩⟩ := by execute 1 -lemma D_leaf_0100 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0100 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (0 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by execute 4 -lemma D_leaf_0101 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_0101 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (tL <{{D}} ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> rD)) := by execute 4 -lemma D_leaf_011 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_011 (tL rD : ListBlank (Fin 2)) : (((0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> rD⟩⟩ := by execute 5 -lemma D_leaf_11 (tL rD : ListBlank (Fin 2)) : +private theorem D_leaf_11 (tL rD : ListBlank (Fin 2)) : (((1 : Fin 2) >> (1 : Fin 2) >> tL) <{{D}} rD) [target_tm]⊢⁺ (((1 : Fin 2) >> tL) <{{F}} ((1 : Fin 2) >> rD)) := by execute 1 -lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : +private theorem D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ (∃ L'' R_P, R_P ≠ [] ∧ cfg' = P_cfg L'' [] R_P) ∨ @@ -1194,9 +1292,12 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : set rD := (([0] : List (Fin 2)) ^ (1 + c)) +> ((1 : Fin 2) >> encTail R) have hrD_right : (1 : Fin 2) >> rD = encRight ((0, c) :: tailAsRight R) := RD_eq_encRight c hc R have hrD_tail : (1 : Fin 2) >> rD = encTail ((1, c) :: tailAsRight R) := RD_eq_encTail_one c hc R - have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := one_cons_RD_eq c hc R - have hrD_two : (1 : Fin 2) >> (1 : Fin 2) >> rD = encTail ((2, c) :: tailAsRight R) := RD_eq_encTail_two c hc R - have hrD_peel : rD = (0 : Fin 2) >> encTail (peelSep c (tailAsRight R)) := rD_eq_zero_cons_peelSep c hc R + have hrD_one : (1 : Fin 2) >> rD = (1 : Fin 2) >> encTail ((0, c) :: tailAsRight R) := + one_cons_RD_eq c hc R + have hrD_two : (1 : Fin 2) >> (1 : Fin 2) >> rD = encTail ((2, c) :: tailAsRight R) := + RD_eq_encTail_two c hc R + have hrD_peel : rD = (0 : Fin 2) >> encTail (peelSep c (tailAsRight R)) := + rD_eq_zero_cons_peelSep c hc R rcases L with _ | ⟨⟨a₁, b₁⟩, L'⟩ · -- L = [] have hL : encTail [] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp @@ -1211,7 +1312,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : have hL : encTail [(0, b₁)] = (0 : Fin 2) >> (0 : Fin 2) >> encTail [] := by simp [encTail_zero] rw [hL] - refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, c) :: tailAsRight R, rfl⟩⟩ + refine ⟨cfg_M0 [] ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], (1, + c) :: tailAsRight R, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 (encTail []) rD · rcases mod4_cases b₁ with hb0 | hb1 | hb2 | hb3 @@ -1232,72 +1334,95 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h20, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨cfg_D 2 ((a₃, b₃) :: L''') ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨2, (a₃, b₃) :: L''', (0, c) :: tailAsRight R, + by decide, by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_one] exact D_leaf_0101 (encTail ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 1 -> cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''') := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, + b₃) :: L''') := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 0) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 (encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 2 -> cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] + refine ⟨cfg_M0 ((0, 1) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD - · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R) + · -- b₂ % 4 = 3 -> cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: + -- tailAsRight R) have hL : encTail ((0, b₁) :: (0, b₂) :: (a₃, b₃) :: L''') = - (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by + (0 : Fin 2) >> (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> ((0 : Fin 2) >> + (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_zero, h23] rfl rw [hL] - refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, c) :: tailAsRight R)] - simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> encRight ((a₃, b₃) :: L''')) rD + refine ⟨cfg_M0 ((0, 2) :: (a₃, b₃) :: L''') ((0, 0) :: (0, c) :: tailAsRight R), + ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 2 ((a₃, b₃) :: L'''), encTail_zero 0 ((0, + c) :: tailAsRight R)] + simpa [hrD_right] using D_leaf_0100 ((0 : Fin 2) >> (0 : Fin 2) >> + encRight ((a₃, b₃) :: L''')) rD · -- a₂ = 1 rcases mod4_cases b₂ with h20 | h21 | h22 | h23 · -- b₂ % 4 = 0 -> pushZeroSep 1 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h20] + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h20] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 1 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 1 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 1 -> pushZeroSep 2 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h21] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h21] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 2 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 2 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 2 -> pushZeroSep 3 L'' have hL : encTail ((0, b₁) :: (1, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h22] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((0 : Fin 2) >> (0 : Fin 2) >> + (0 : Fin 2) >> encRight L'') := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, + encTail_zero, h22] rfl rw [hL] - refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 (pushZeroSep 3 L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, + _, rfl⟩⟩ rw [cfg_M0_eq, encTail_pushZeroSep 3 (by decide) L'', ← hrD_tail] simpa using D_leaf_011 ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encRight L'') rD · -- b₂ % 4 = 3: split L'' = [] vs (a₃, b₃) :: L''' @@ -1312,24 +1437,30 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · -- P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (1, b₂) :: (a₃, b₃) :: L''') = (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> - ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₃, b₃) :: L''')) := by + ((0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₃, b₃) :: L''')) := by rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ, encTail_zero, h23, encRight_cons_eq_one_cons_encTail] rfl rw [hL] refine ⟨P_cfg ((a₃, b₃) :: L''') [] ((0, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inl ⟨(a₃, b₃) :: L''', (0, c) :: tailAsRight R, by simp, + rfl⟩))⟩ unfold P_cfg wall rw [listblank_append_nil, ← hrD_right] exact D_leaf_011 _ rD · -- a₂ = a₂' + 2 -> cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R) have hL : encTail ((0, b₁) :: (a₂' + 2, b₂) :: L'') = - (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) := by - rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), encTail_succ a₂'] + (0 : Fin 2) >> (1 : Fin 2) >> (1 : Fin 2) >> ((1 : Fin 2) >> encTail ((a₂', + b₂) :: L'')) := by + rw [encTail_zero, hb0, encRight_cons_eq_one_cons_encTail, encTail_succ (a₂' + 1), + encTail_succ a₂'] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_tail] + refine ⟨cfg_M0 ((0, 0) :: (a₂', b₂) :: L'') ((1, c) :: tailAsRight R), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂', b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_tail] simpa using D_leaf_011 ((1 : Fin 2) >> encTail ((a₂', b₂) :: L'')) rD · -- b₁ % 4 = 1 -> Leaf 00, L' = (a₂ + 1, b₂) :: L'' have hL : encTail ((0, b₁) :: (a₂, b₂) :: L'') = @@ -1337,7 +1468,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb1, encTail_succ, encRight_cons_eq_one_cons_encTail] rfl rw [hL] - refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((a₂ + 1, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, + rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 2 -> Leaf 00, L' = (0, 0) :: (a₂, b₂) :: L'' @@ -1346,7 +1478,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb2, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- b₁ % 4 = 3 -> Leaf 00, L' = (0, 1) :: (a₂, b₂) :: L'' @@ -1355,7 +1488,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [encTail_zero, hb3, encTail_zero] rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ rw [cfg_M0_eq, ← hrD_tail] exact D_leaf_00 _ rD · -- a₁ = 1 (F0 = 1LE -> 4-step and 7-step leaves!) @@ -1364,7 +1498,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : ⟨some A, ⟨0, (0 : Fin 2) >> tL, (1 : Fin 2) >> (1 : Fin 2) >> rD⟩⟩ := by intro tL; execute 4 rcases L' with _ | ⟨⟨a₂, b₂⟩, L''⟩ - · have hL : encTail [(1, b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by + · have hL : encTail [(1, + b₁)] = (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> default := by simp [encTail_succ, encTail_zero] rw [hL] refine ⟨cfg_M0 [] ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ @@ -1375,7 +1510,8 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : (1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb0, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - have h7 : (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) <{{D}} rD) [target_tm]⊢⁺ + have h7 : (((1 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, + b₂) :: L'')) <{{D}} rD) [target_tm]⊢⁺ ⟨some A, ⟨0, (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂, b₂) :: L''), encTail (peelSep c (tailAsRight R))⟩⟩ := by rw [hrD_peel] @@ -1384,43 +1520,53 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : · rcases L'' with _ | ⟨⟨a₃, b₃⟩, L'''⟩ · refine ⟨cfg_M0 [] (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, [], _, rfl⟩⟩ rw [cfg_M0_eq, encTail_nil] - have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail [(0, b₂)] = default := by + have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail [(0, + b₂)] = default := by simp [encTail_zero] rw [← h0] exact h7 · rcases mod4_cases b₂ with h20 | h21 | h22 | h23 - · refine ⟨cfg_M0 ((0, 3) :: (a₃, b₃) :: L''') (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + · refine ⟨cfg_M0 ((0, 3) :: (a₃, b₃) :: L''') (peelSep c (tailAsRight R)), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 3 ((a₃, b₃) :: L''')] - have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, + b₃) :: L''') = (([0] : List (Fin 2)) ^ (1 + 3 % 4)) +> encRight ((a₃, b₃) :: L''') := by rw [encTail_zero, h20]; rfl rw [← h0] exact h7 - · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, + b₃) :: L''') = (([0] : List (Fin 2)) ^ 0) +> wall ((a₃, b₃) :: L''') := by rw [encTail_zero, h21, encRight_cons_eq_one_cons_encTail]; rfl rw [h0] at h7 - obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 0 c (tailAsRight R) h7 + obtain ⟨cfg', hstep, hout⟩ := + A_wall_peelSep_closed ((a₃, b₃) :: L''') 0 c (tailAsRight R) h7 rcases hout with hM | hH · exact ⟨cfg', hstep, Or.inl hM⟩ · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ - · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, + b₃) :: L''') = (([0] : List (Fin 2)) ^ 1) +> wall ((a₃, b₃) :: L''') := by rw [encTail_zero, h22, encRight_cons_eq_one_cons_encTail]; rfl rw [h0] at h7 - obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 1 c (tailAsRight R) h7 + obtain ⟨cfg', hstep, hout⟩ := + A_wall_peelSep_closed ((a₃, b₃) :: L''') 1 c (tailAsRight R) h7 rcases hout with hM | hH · exact ⟨cfg', hstep, Or.inl hM⟩ · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ - · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, b₃) :: L''') = + · have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((0, b₂) :: (a₃, + b₃) :: L''') = (([0] : List (Fin 2)) ^ 2) +> wall ((a₃, b₃) :: L''') := by rw [encTail_zero, h23, encRight_cons_eq_one_cons_encTail]; rfl rw [h0] at h7 - obtain ⟨cfg', hstep, hout⟩ := A_wall_peelSep_closed ((a₃, b₃) :: L''') 2 c (tailAsRight R) h7 + obtain ⟨cfg', hstep, hout⟩ := + A_wall_peelSep_closed ((a₃, b₃) :: L''') 2 c (tailAsRight R) h7 rcases hout with hM | hH · exact ⟨cfg', hstep, Or.inl hM⟩ · exact ⟨cfg', hstep, Or.inr (Or.inl hH)⟩ - · refine ⟨cfg_M0 ((0, 2) :: (a₂', b₂) :: L'') (peelSep c (tailAsRight R)), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ + · refine ⟨cfg_M0 ((0, 2) :: (a₂', b₂) :: L'') (peelSep c (tailAsRight R)), ?_, + Or.inl ⟨.M0, _, _, rfl⟩⟩ rw [cfg_M0_eq, encTail_zero 2 ((a₂', b₂) :: L'')] have h0 : (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> encTail ((a₂' + 1, b₂) :: L'') = (([0] : List (Fin 2)) ^ (1 + 2 % 4)) +> encRight ((a₂', b₂) :: L'') := by @@ -1428,29 +1574,37 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : rw [← h0] exact h7 · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, + b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb1, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] refine ⟨cfg_D 1 ((a₂, b₂) :: L'') ((1, c) :: tailAsRight R), ?_, - Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (1, c) :: tailAsRight R, by decide, by simp, rfl⟩))⟩ + Or.inr (Or.inr (Or.inr ⟨1, (a₂, b₂) :: L'', (1, c) :: tailAsRight R, by decide, + by simp, rfl⟩))⟩ unfold cfg_D dsimp only [pow_succ_list, pow_zero_list, cons_append_list, nil_append_list, listblank_append_cons, listblank_append_nil] rw [← hrD_tail] execute 4 · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> + encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb2, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + refine ⟨cfg_M0 ((0, 0) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 0 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_two] simpa using h1000 ((1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) · have hL : encTail ((1, b₁) :: (a₂, b₂) :: L'') = - (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by + (1 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> (0 : Fin 2) >> + (1 : Fin 2) >> encTail ((a₂, b₂) :: L'') := by rw [encTail_succ, encTail_zero, hb3, encRight_cons_eq_one_cons_encTail]; rfl rw [hL] - refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, _, _, rfl⟩⟩ - rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, ← hrD_two] + refine ⟨cfg_M0 ((0, 1) :: (a₂, b₂) :: L'') ((2, c) :: tailAsRight R), ?_, Or.inl ⟨.M0, + _, _, rfl⟩⟩ + rw [cfg_M0_eq, encTail_zero 1 ((a₂, b₂) :: L''), encRight_cons_eq_one_cons_encTail, + ← hrD_two] simpa using h1000 ((0 : Fin 2) >> (1 : Fin 2) >> encTail ((a₂, b₂) :: L'')) · -- a₁ = a₁' + 2 -> Leaf 11 -> Halts in 1 step! have hL : encTail ((a₁' + 2, b₁) :: L') = @@ -1460,7 +1614,7 @@ lemma D_step_one (c : ℕ) (hc : c < 4) (L R : List (ℕ × ℕ)) : refine ⟨((1 : Fin 2) >> encTail ((a₁', b₁) :: L')) <{{F}} ((1 : Fin 2) >> rD), D_leaf_11 _ rD, Or.inr (Or.inl (F_halt_on_one _ _))⟩ -theorem stage2_closed (n : ℕ) : +private theorem stage2_closed (n : ℕ) : ∀ L, L.length ≤ n → ∀ c < 4, ∀ R, ∃ cfg', ((cfg_D c L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ @@ -1489,7 +1643,7 @@ theorem stage2_closed (n : ℕ) : -- ============================================================================ -theorem stage1_step_all (L R : List (ℕ × ℕ)) : +private theorem stage1_step_all (L R : List (ℕ × ℕ)) : ∃ cfg', ((cfg_M0 L R) [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone ∨ ∃ L' R', cfg' = cfg_D 0 L' R') := by rcases R with _ | ⟨⟨d, bR⟩, R'⟩ @@ -1505,7 +1659,7 @@ theorem stage1_step_all (L R : List (ℕ × ℕ)) : · exact ⟨cfg', h, Or.inl hM⟩ · exact ⟨cfg', h, Or.inr (Or.inl hH)⟩ -theorem stack_system_closed : +private theorem stack_system_closed : ∀ cfg, IsInStackSystem cfg → ∃ cfg', (cfg [target_tm]⊢⁺ cfg') ∧ (IsInStackSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -1524,11 +1678,9 @@ theorem stack_system_closed : · obtain ⟨cfg₃, h₃, hout₃⟩ := stage3_closed L'' R_P hRP exact ⟨cfg₃, stepPlus_trans (stepPlus_trans h₁ h₂) h₃, hout₃⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_stack_cryptid : IsStackCryptid target_tm := by +theorem is_stack_cryptid : IsStackCryptid target := by + rw [target_eq_target_tm] refine ⟨StackMode, 1, 0, encLeft, encRight, evalStackCfg, IsInStackSystem, Or.inl ⟨rfl, rfl⟩, rfl, rfl, audit_encLeft_head, audit_encRight_head, diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean index 4c9f37f2..756aa1b6 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 0, Stmt.write 0 Dir.right) | 1, 0 => some (some 2, Stmt.write 0 Dir.left) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.right) | 5, 1 => some (some 4, Stmt.write 1 Dir.left) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -81,28 +73,38 @@ deriving DecidableEq, Repr /-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), forbidding `[0, 0, 0, 1]`. -/ -@[simp] -def lWord : ℕ × Bool → List (Fin 2) - | (0, false) => [1, 0] - | (d + 1, false) => 1 :: lWord (d, false) - | (0, true) => [1, 0, 0] - | (k + 1, true) => 1 :: 1 :: lWord (k, true) +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +@[simp] private theorem lWord_zero_false : lWord (0, false) = [1, 0] := rfl +@[simp] private theorem lWord_succ_false (d : ℕ) : + lWord (d + 1, false) = 1 :: lWord (d, false) := rfl +@[simp] private theorem lWord_zero_true : lWord (0, true) = [1, 0, 0] := rfl +@[simp] private theorem lWord_succ_true (k : ℕ) : + lWord (k + 1, true) = 1 :: 1 :: lWord (k, true) := rfl /-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | z + 1 => 0 :: zWord z +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k -@[simp] -def encLeft : List (ℕ × Bool) → zB - | [] => default - | p :: L => lWord p +> encLeft L +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl -@[simp] -def encRight : List ℕ → zB - | [] => default - | z :: R => zWord z +> encRight R +def encLeft (S : List (ℕ × Bool)) : zB := + List.rec default (fun p _ acc => lWord p +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (p : (ℕ × Bool)) (S : List (ℕ × Bool)) : + encLeft (p :: S) = lWord p +> encLeft S := rfl + +def encRight (S : List ℕ) : zB := + List.rec default (fun z _ acc => zWord z +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (z : ℕ) (S : List ℕ) : + encRight (z :: S) = zWord z +> encRight S := rfl abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ @@ -120,82 +122,88 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.1.map lWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default -lemma evalSegRegion_zWord (R : List ℕ) : +private theorem evalSegRegion_zWord (R : List ℕ) : evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons z rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsL (m, L, R)) = encRight R := evalSegRegion_zWord R @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsR (m, L, R)) = encLeft L := evalSegRegion_lWord L -lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : (encLeft (p :: L)).nth 0 = 1 := by rcases p with ⟨_ | d, _ | _⟩ <;> - simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] -lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : +private theorem noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) induction d with | zero => cases b <;> ( - simp only [lWord, ListBlank.append, zero_cons_default] + simp only [lWord_zero_false, lWord_zero_true, + ListBlank.append, zero_cons_default] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) +private theorem noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by induction d with | zero => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_false, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_true, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) @@ -207,18 +215,20 @@ lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_encLeft : +private theorem noFactor_0001_encLeft : ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) | [(d, b)] => noFactor_0001_lWord_nil d b @@ -226,13 +236,58 @@ lemma noFactor_0001_encLeft : noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) (noFactor_0001_encLeft (p :: L)) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 0, 0, 1] (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_0001_encLeft L) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ +def modes : List SegMode := [.mCL, .mAR, .mA0] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem lWord_len : ∀ p : ℕ × Bool, 2 ≤ (lWord p).length + | (0, false) => by simp [lWord_zero_false] + | (d + 1, false) => by have := lWord_len (d, false); simp only [ + lWord_succ_false, List.length_cons]; omega + | (0, true) => by simp [lWord_zero_true] + | (k + 1, true) => by have := lWord_len (k, true); simp only [ + lWord_succ_true, List.length_cons]; omega + +private theorem lWord_ne_nil (p : ℕ × Bool) : lWord p ≠ [] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem lWord_ne_zero (p : ℕ × Bool) : lWord p ≠ [(0 : Fin 2)] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact lWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact lWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) @@ -244,7 +299,7 @@ def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fi def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -273,7 +328,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -303,124 +358,132 @@ def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := @[simp] def s₀ : SegState := (.mCL, [(0, false), (0, false)], [0]) -lemma zero_cons_encRight (R : List ℕ) : +private theorem zero_cons_encRight (R : List ℕ) : (0 : Fin 2) >> encRight R = encRight (push0R R) := by - cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] -lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : +private theorem pat11_cons_encLeft (L : List (ℕ × Bool)) : (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> - simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + simp [bump2L, encLeft_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mCL [(0, false), (0, false)] [0] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : (step target_tm (cfgHalt L Rt)).isNone := by - simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] -- Mode mCL (<2) transitions -lemma step_mCL_nil_nil : +private theorem step_mCL_nil_nil : (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_0_halt (Rt : List ℕ) : +private theorem step_mCL_nil_0_halt (Rt : List ℕ) : (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, cfgHalt, applyView, encLeft_nil, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : +private theorem step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_0_false_nil (R : List ℕ) : +private theorem step_mCL_0_false_nil (R : List ℕ) : (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by - simp only [evalSegCfg, applyView, encLeft, lWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, lWord_zero_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + zero_cons_default] execute -lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by cases d <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by cases k <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((d, false) :: L) (push0R R) := by cases d <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by cases k <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) @[simp] @@ -428,7 +491,7 @@ def push00IterR : ℕ → List ℕ → List ℕ | 0, R => R | k + 1, R => push00IterR k (push0R (push0R R)) -lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by induction k generalizing R with @@ -440,128 +503,134 @@ lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) -- Mode mAR (0>) transitions -lemma step_mAR_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAR_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, false) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by - simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -- Mode mA0 (0> with leading 0) transitions -lemma step_mA0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, true) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -641,23 +710,24 @@ theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean index 9e81c0f5..4d8fffc2 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.right) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 0 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -81,28 +73,38 @@ deriving DecidableEq, Repr /-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), forbidding `[0, 0, 0, 1]`. -/ -@[simp] -def lWord : ℕ × Bool → List (Fin 2) - | (0, false) => [1, 0] - | (d + 1, false) => 1 :: lWord (d, false) - | (0, true) => [1, 0, 0] - | (k + 1, true) => 1 :: 1 :: lWord (k, true) +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +@[simp] private theorem lWord_zero_false : lWord (0, false) = [1, 0] := rfl +@[simp] private theorem lWord_succ_false (d : ℕ) : + lWord (d + 1, false) = 1 :: lWord (d, false) := rfl +@[simp] private theorem lWord_zero_true : lWord (0, true) = [1, 0, 0] := rfl +@[simp] private theorem lWord_succ_true (k : ℕ) : + lWord (k + 1, true) = 1 :: 1 :: lWord (k, true) := rfl /-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | z + 1 => 0 :: zWord z +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k -@[simp] -def encLeft : List (ℕ × Bool) → zB - | [] => default - | p :: L => lWord p +> encLeft L +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl -@[simp] -def encRight : List ℕ → zB - | [] => default - | z :: R => zWord z +> encRight R +def encLeft (S : List (ℕ × Bool)) : zB := + List.rec default (fun p _ acc => lWord p +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (p : (ℕ × Bool)) (S : List (ℕ × Bool)) : + encLeft (p :: S) = lWord p +> encLeft S := rfl + +def encRight (S : List ℕ) : zB := + List.rec default (fun z _ acc => zWord z +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (z : ℕ) (S : List ℕ) : + encRight (z :: S) = zWord z +> encRight S := rfl abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ @@ -120,82 +122,88 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map zWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default -lemma evalSegRegion_zWord (R : List ℕ) : +private theorem evalSegRegion_zWord (R : List ℕ) : evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons z rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsL (m, L, R)) = encLeft L := evalSegRegion_lWord L @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_zWord R -lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : (encLeft (p :: L)).nth 0 = 1 := by rcases p with ⟨_ | d, _ | _⟩ <;> - simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] -lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : +private theorem noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) induction d with | zero => cases b <;> ( - simp only [lWord, ListBlank.append, zero_cons_default] + simp only [lWord_zero_false, lWord_zero_true, + ListBlank.append, zero_cons_default] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) +private theorem noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by induction d with | zero => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_false, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_true, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) @@ -207,18 +215,20 @@ lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_encLeft : +private theorem noFactor_0001_encLeft : ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) | [(d, b)] => noFactor_0001_lWord_nil d b @@ -226,13 +236,58 @@ lemma noFactor_0001_encLeft : noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) (noFactor_0001_encLeft (p :: L)) -lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := +theorem segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 0, 1] (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_0001_encLeft L) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ +def modes : List SegMode := [.mCL, .mAR, .mA0] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem lWord_len : ∀ p : ℕ × Bool, 2 ≤ (lWord p).length + | (0, false) => by simp [lWord_zero_false] + | (d + 1, false) => by have := lWord_len (d, false); simp only [ + lWord_succ_false, List.length_cons]; omega + | (0, true) => by simp [lWord_zero_true] + | (k + 1, true) => by have := lWord_len (k, true); simp only [ + lWord_succ_true, List.length_cons]; omega + +private theorem lWord_ne_nil (p : ℕ × Bool) : lWord p ≠ [] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem lWord_ne_zero (p : ℕ × Bool) : lWord p ≠ [(0 : Fin 2)] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact lWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact lWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) @@ -244,7 +299,7 @@ def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fi def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -273,7 +328,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inr rfl) -lemma segsR_boundary_aligned : +theorem segsR_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vL, (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ @@ -303,124 +358,132 @@ def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := @[simp] def s₀ : SegState := (.mCL, [(0, false)], [0]) -lemma zero_cons_encRight (R : List ℕ) : +private theorem zero_cons_encRight (R : List ℕ) : (0 : Fin 2) >> encRight R = encRight (push0R R) := by - cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] -lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : +private theorem pat11_cons_encLeft (L : List (ℕ × Bool)) : (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> - simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + simp [bump2L, encLeft_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mCL [(0, false)] [0] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : (step target_tm (cfgHalt L Rt)).isNone := by - simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] -- Mode mCL (<2) transitions -lemma step_mCL_nil_nil : +private theorem step_mCL_nil_nil : (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_0_halt (Rt : List ℕ) : +private theorem step_mCL_nil_0_halt (Rt : List ℕ) : (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, cfgHalt, applyView, encLeft_nil, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : +private theorem step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_0_false_nil (R : List ℕ) : +private theorem step_mCL_0_false_nil (R : List ℕ) : (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by - simp only [evalSegCfg, applyView, encLeft, lWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, lWord_zero_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + zero_cons_default] execute -lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by cases d <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by cases k <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((d, false) :: L) (push0R R) := by cases d <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by cases k <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) @[simp] @@ -428,7 +491,7 @@ def push00IterR : ℕ → List ℕ → List ℕ | 0, R => R | k + 1, R => push00IterR k (push0R (push0R R)) -lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by induction k generalizing R with @@ -440,128 +503,134 @@ lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) -- Mode mAR (0>) transitions -lemma step_mAR_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAR_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, false) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by - simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -- Mode mA0 (0> with leading 0) transitions -lemma step_mA0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, true) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -641,24 +710,25 @@ theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inl segsL_nowhere_dense, Or.inl segsL_nowhere_dense, Or.inr segsR_boundary_aligned, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean index ac5fa984..458ed12d 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 4, Stmt.write 0 Dir.right) | 1, 0 => some (some 2, Stmt.write 1 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 2, Stmt.write 1 Dir.right) | 5, 1 => some (some 5, Stmt.write 0 Dir.left) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -132,91 +132,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := evalSegRegion_zWord (leftList m L) @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -231,7 +286,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -275,7 +330,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -312,57 +367,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [0, 0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0, 0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -370,143 +425,145 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + zWord_zero, zWord_succ, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + default_head, default_tail]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -573,23 +630,24 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ + +/-- Segmented cryptid certificate for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ end BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean index f257f6a1..6489b1f8 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 5, Stmt.write 0 Dir.right) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 2, Stmt.write 1 Dir.left) | 5, 1 => some (some 0, Stmt.write 1 Dir.right) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -126,91 +126,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft L := evalSegRegion_zWord L @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -225,7 +280,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -269,7 +324,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -306,57 +361,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mCL1, [0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mCL1 [0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -364,143 +419,142 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt L o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mAL L ((1, 0) :: (z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -565,24 +619,25 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mAL, L, (1, 0) :: (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mAL, L, (1, 0) :: (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA diff --git a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean index 118a300d..9f1a9599 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 5, Stmt.write 0 Dir.right) | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 4, Stmt.write 1 Dir.left) | 5, 1 => some (some 0, Stmt.write 1 Dir.right) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -132,91 +132,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := evalSegRegion_zWord (leftList m L) @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -231,7 +286,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -275,7 +330,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -312,57 +367,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [1, 0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [1, 0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -370,143 +425,144 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -573,24 +629,25 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA diff --git a/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean b/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean index a6e9a062..d7defc7f 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => some (some 5, Stmt.write 1 Dir.right) | 1, 0 => some (some 2, Stmt.write 1 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 1, Stmt.write 0 Dir.right) | 5, 1 => none --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -81,28 +73,38 @@ deriving DecidableEq, Repr /-- Left half-tape word `1^(d+1) ++ [0]` (`b = false`) or `1^(2d+1) ++ [0, 0]` (`b = true`), forbidding `[0, 0, 0, 1]`. -/ -@[simp] -def lWord : ℕ × Bool → List (Fin 2) - | (0, false) => [1, 0] - | (d + 1, false) => 1 :: lWord (d, false) - | (0, true) => [1, 0, 0] - | (k + 1, true) => 1 :: 1 :: lWord (k, true) +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +@[simp] private theorem lWord_zero_false : lWord (0, false) = [1, 0] := rfl +@[simp] private theorem lWord_succ_false (d : ℕ) : + lWord (d + 1, false) = 1 :: lWord (d, false) := rfl +@[simp] private theorem lWord_zero_true : lWord (0, true) = [1, 0, 0] := rfl +@[simp] private theorem lWord_succ_true (k : ℕ) : + lWord (k + 1, true) = 1 :: 1 :: lWord (k, true) := rfl /-- Right half-tape parameterized zero-run word `0^z ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | z + 1 => 0 :: zWord z +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k -@[simp] -def encLeft : List (ℕ × Bool) → zB - | [] => default - | p :: L => lWord p +> encLeft L +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl -@[simp] -def encRight : List ℕ → zB - | [] => default - | z :: R => zWord z +> encRight R +def encLeft (S : List (ℕ × Bool)) : zB := + List.rec default (fun p _ acc => lWord p +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (p : (ℕ × Bool)) (S : List (ℕ × Bool)) : + encLeft (p :: S) = lWord p +> encLeft S := rfl + +def encRight (S : List ℕ) : zB := + List.rec default (fun z _ acc => zWord z +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (z : ℕ) (S : List ℕ) : + encRight (z :: S) = zWord z +> encRight S := rfl abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ @@ -120,82 +122,88 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map zWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_lWord (L : List (ℕ × Bool)) : +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default -lemma evalSegRegion_zWord (R : List ℕ) : +private theorem evalSegRegion_zWord (R : List ℕ) : evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons z rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsL (m, L, R)) = encLeft L := evalSegRegion_lWord L @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_zWord R -lemma encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : (encLeft (p :: L)).nth 0 = 1 := by rcases p with ⟨_ | d, _ | _⟩ <;> - simp only [encLeft, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] -lemma noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : +private theorem noFactor_0001_lWord_nil (d : ℕ) (b : Bool) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> (default : zB)) := by have hd : WordRunStack.NoFactor [0, 0, 0, 1] (default : zB) := WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) induction d with | zero => cases b <;> ( - simp only [lWord, ListBlank.append, zero_cons_default] + simp only [lWord_zero_false, lWord_zero_true, + ListBlank.append, zero_cons_default] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) default hd 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide)) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> default)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) +private theorem noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) (ht : WordRunStack.NoFactor [0, 0, 0, 1] t) : WordRunStack.NoFactor [0, 0, 0, 1] (lWord (d, b) +> t) := by induction d with | zero => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_false, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h0 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_zero_true, + ListBlank.append] have h0 : WordRunStack.NoFactor [0, 0, 0, 1] ((0 : Fin 2) >> t) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (0 : Fin 2) t ht 1 (by decide) (by rw [WordRunStack.nth_cons_succ, ht0]; decide) @@ -207,18 +215,20 @@ lemma noFactor_0001_lWord_cons (d : ℕ) (b : Bool) (t : zB) (ht0 : t.nth 0 = 1) | succ d ih => cases b with | false => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_false, + ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | true => - simp only [lWord, ListBlank.append] + simp only [lWord_succ_true, + ListBlank.append] have h1 : WordRunStack.NoFactor [0, 0, 0, 1] ((1 : Fin 2) >> (lWord (d, true) +> t)) := WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 0, 0, 1] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_0001_encLeft : +private theorem noFactor_0001_encLeft : ∀ L : List (ℕ × Bool), WordRunStack.NoFactor [0, 0, 0, 1] (encLeft L) | [] => WordRunStack.noFactor_default [0, 0, 0, 1] 3 (by decide) (by decide) | [(d, b)] => noFactor_0001_lWord_nil d b @@ -226,13 +236,58 @@ lemma noFactor_0001_encLeft : noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) (noFactor_0001_encLeft (p :: L)) -lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := +theorem segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 0, 0, 1] (fun ⟨_, L, _⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_0001_encLeft L) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ +def modes : List SegMode := [.mCL, .mAR, .mA0] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem lWord_len : ∀ p : ℕ × Bool, 2 ≤ (lWord p).length + | (0, false) => by simp [lWord_zero_false] + | (d + 1, false) => by have := lWord_len (d, false); simp only [ + lWord_succ_false, List.length_cons]; omega + | (0, true) => by simp [lWord_zero_true] + | (k + 1, true) => by have := lWord_len (k, true); simp only [ + lWord_succ_true, List.length_cons]; omega + +private theorem lWord_ne_nil (p : ℕ × Bool) : lWord p ≠ [] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem lWord_ne_zero (p : ℕ × Bool) : lWord p ≠ [(0 : Fin 2)] := by + intro h; have := lWord_len p; simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact lWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact lWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) @@ -244,7 +299,7 @@ def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fi def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -273,7 +328,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inr rfl) -lemma segsR_boundary_aligned : +theorem segsR_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vL, (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ @@ -303,124 +358,132 @@ def cfgHalt (L : List (ℕ × Bool)) (R : List ℕ) : Cfg (Fin 2) (Fin 6) := @[simp] def s₀ : SegState := (.mAR, [(0, false)], []) -lemma zero_cons_encRight (R : List ℕ) : +private theorem zero_cons_encRight (R : List ℕ) : (0 : Fin 2) >> encRight R = encRight (push0R R) := by - cases R <;> simp [push0R, encRight, zWord, ListBlank.append, zero_cons_default] + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] -lemma pat11_cons_encLeft (L : List (ℕ × Bool)) : +private theorem pat11_cons_encLeft (L : List (ℕ × Bool)) : (1 : Fin 2) >> (1 : Fin 2) >> encLeft L = encLeft (bump2L L) := by rcases L with _ | ⟨⟨_ | d, _ | _⟩, L⟩ <;> - simp [bump2L, encLeft, lWord, ListBlank.append, zero_cons_default] + simp [bump2L, encLeft_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mAR [(0, false)] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : (step target_tm (cfgHalt L Rt)).isNone := by - simp [cfgHalt, encRight, zWord, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] -- Mode mCL (<2) transitions -lemma step_mCL_nil_nil : +private theorem step_mCL_nil_nil : (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_0_halt (Rt : List ℕ) : +private theorem step_mCL_nil_0_halt (Rt : List ℕ) : (evalSegCfg .mCL [] (0 :: Rt)) [target_tm]⊢⁺ cfgHalt [(0, false)] Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, cfgHalt, applyView, encLeft_nil, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : +private theorem step_mCL_nil_succ (z : ℕ) (Rt : List ℕ) : (evalSegCfg .mCL [] ((z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, zero_cons_default, default_head, default_tail] execute -lemma step_mCL_0_false_nil (R : List ℕ) : +private theorem step_mCL_0_false_nil (R : List ℕ) : (evalSegCfg .mCL [(0, false)] R) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] R := by - simp only [evalSegCfg, applyView, encLeft, lWord, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, lWord_zero_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + zero_cons_default] execute -lemma step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: 0 :: push0R R) := by - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_1_false (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, true) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ2_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (d + 2, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (d, false) :: L) R := by cases d <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_false_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, false) :: (k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: (0, false) :: (k, true) :: L) R := by cases k <;> ( - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_0_true (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((0, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) R := by - simp only [evalSegCfg, applyView, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_false (d : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((d + 1, false) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((d, false) :: L) (push0R R) := by cases d <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) -lemma step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_succ_true (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k + 1, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL ((k, true) :: L) (push0R (push0R R)) := by cases k <;> ( - simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft, lWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← zero_cons_encRight, encLeft_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute) @[simp] @@ -428,7 +491,7 @@ def push00IterR : ℕ → List ℕ → List ℕ | 0, R => R | k + 1, R => push00IterR k (push0R (push0R R)) -lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : (evalSegCfg .mCL ((k, true) :: L) R) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (push00IterR k R) := by induction k generalizing R with @@ -440,128 +503,134 @@ lemma step_mCL_true_sweep (k : ℕ) (L : List (ℕ × Bool)) (R : List ℕ) : exact stepPlus_trans (step_mCL_succ_true k L R) (ih (push0R (push0R R))) -- Mode mAR (0>) transitions -lemma step_mAR_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAR_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mAR_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mAR L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, false) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, false) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR (bump2L L) Rt := by - simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, ← pat11_cons_encLeft, encRight_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mAR_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mAR L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL L (1 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -- Mode mA0 (0> with leading 0) transitions -lemma step_mA0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L []) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) [0] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0]) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_nil (L : List (ℕ × Bool)) : +private theorem step_mA0_0_0_nil (L : List (ℕ × Bool)) : (evalSegCfg .mA0 L [0, 0]) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] execute -lemma step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_0_halt (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: 0 :: Rt)) [target_tm]⊢⁺ cfgHalt ((0, true) :: L) Rt := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: 0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mA0 ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_0_succ (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (0 :: (z + 1) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((0, true) :: L) (z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_1_cons (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L (1 :: Rt)) [target_tm]⊢⁺ evalSegCfg .mAR ((1, false) :: L) Rt := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -lemma step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : +private theorem step_mA0_succ2 (z : ℕ) (L : List (ℕ × Bool)) (Rt : List ℕ) : (evalSegCfg .mA0 L ((z + 2) :: Rt)) [target_tm]⊢⁺ evalSegCfg .mCL ((0, false) :: L) (0 :: z :: Rt) := by - simp only [evalSegCfg, applyView, encLeft, encRight, lWord, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] execute -theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : +private theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -641,23 +710,24 @@ theorem segmented_step_sound (m : SegMode) (L : List (ℕ × Bool)) (R : List · exact ⟨evalCfg (.mCL, (0, false) :: L, 0 :: z :: Rt), step_mA0_succ2 z L Rt, Or.inl ⟨(.mCL, (0, false) :: L, 0 :: z :: Rt), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mCL, .mAR, .mA0], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inl segsL_nowhere_dense, Or.inl segsL_nowhere_dense, Or.inr segsR_boundary_aligned, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean index 00ba2320..e7444050 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => none | 1, 0 => some (some 2, Stmt.write 0 Dir.right) @@ -49,23 +45,19 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.right) | 5, 1 => some (some 3, Stmt.write 0 Dir.right) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 open Counter local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step1" : tactic => `(tactic| try (any_goals (first | finish | gstep))) @@ -83,32 +75,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -132,91 +132,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord (s.2.2.map rWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encLeft (leftList m L) := evalSegRegion_zWord (leftList m L) @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encRight R := evalSegRegion_rWord R -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := +theorem segsR_nowhere_dense : IsNowhereDenseHalf ValidSeg segsR := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsR [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsR]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -231,7 +286,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -275,7 +330,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inl rfl) -lemma segsL_boundary_aligned : +theorem segsL_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vR, (evalCfg s = ⟨some q, ⟨0, evalSegmentedHalf (segsL s), vR⟩⟩) ∨ (evalCfg s = (evalSegmentedHalf (segsL s)) <{{q}} vR) ∨ @@ -312,57 +367,57 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [0], []) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0] [] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] execute -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -370,143 +425,145 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + zWord_zero, zWord_succ, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + default_head, default_tail]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: 0 :: 0 :: 1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -573,23 +630,24 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mB0, 0 :: 0 :: 0 :: 1 :: L, (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inr segsR_nowhere_dense, Or.inr segsL_boundary_aligned, Or.inl segsR_nowhere_dense, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ + +/-- Segmented cryptid certificate for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ end BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean index 53d48d87..f7a51fee 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false - /-! -# Busy Beaver Machine `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` — `is_segmented_cryptid` (`IsSegmentedCryptid target_tm`) +# Busy Beaver Machine `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` (`IsSegmentedCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedSegmentedSystem` and `IsSegmentedCryptid` proofs for +`1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => none | 1, 0 => some (some 2, Stmt.write 1 Dir.left) @@ -49,26 +45,22 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 0, Stmt.write 1 Dir.left) | 5, 1 => some (some 4, Stmt.write 0 Dir.left) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 400000 -set_option maxRecDepth 10000 -@[simp] lemma default_head : (default : zB).head = 0 := rfl -@[simp] lemma default_tail : (default : zB).tail = default := rfl +@[simp] private theorem default_head : (default : zB).head = 0 := rfl +@[simp] private theorem default_tail : (default : zB).tail = default := rfl open Counter local macro "finish" : tactic => `(tactic| first | exact ⟨0, rfl⟩ | (exists 0 <;> fail)) local macro "gstep" : tactic => `(tactic| (try refine stepPlus_stepStar ?_) <;> - refine step_stepStar_stepPlus (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> + refine step_stepStar_stepPlus + (by (try simp only [Turing.ListBlank.head_cons, default_head]); rfl) ?_ <;> simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, zero_cons_default, default_head, default_tail]) local macro "step" : tactic => `(tactic| gstep) @@ -87,32 +79,40 @@ inductive SegMode where deriving DecidableEq, Repr /-- Left half-tape parameterized zero-run word `0^k ++ [1]`. -/ -@[simp] -def zWord : ℕ → List (Fin 2) - | 0 => [1] - | k + 1 => 0 :: zWord k +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +@[simp] private theorem zWord_zero : zWord 0 = [1] := rfl +@[simp] private theorem zWord_succ (k : ℕ) : zWord (k + 1) = 0 :: zWord k := rfl /-- Right half-tape `1`-run word `1^(o+2)` of length at least `2`. -/ -@[simp] -def oRun : ℕ → List (Fin 2) - | 0 => [1, 1] - | o + 1 => 1 :: oRun o +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +@[simp] private theorem oRun_zero : oRun 0 = [1, 1] := rfl +@[simp] private theorem oRun_succ (o : ℕ) : oRun (o + 1) = 1 :: oRun o := rfl /-- Right half-tape word `0^z ++ 1^(o+2)` avoiding isolated `1`s (`010`). -/ -@[simp] -def rWord : ℕ × ℕ → List (Fin 2) - | (0, o) => oRun o - | (z + 1, o) => 0 :: rWord (z, o) +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 -@[simp] -def encLeft : List ℕ → zB - | [] => default - | k :: L => zWord k +> encLeft L +@[simp] private theorem rWord_zero (o : ℕ) : rWord (0, o) = oRun o := rfl +@[simp] private theorem rWord_succ (z o : ℕ) : + rWord (z + 1, o) = 0 :: rWord (z, o) := rfl -@[simp] -def encRight : List (ℕ × ℕ) → zB - | [] => default - | p :: R => rWord p +> encRight R +def encLeft (S : List ℕ) : zB := + List.rec default (fun k _ acc => zWord k +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (k : ℕ) (S : List ℕ) : + encLeft (k :: S) = zWord k +> encLeft S := rfl + +def encRight (S : List (ℕ × ℕ)) : zB := + List.rec default (fun p _ acc => rWord p +> acc) S + +@[simp] private theorem encRight_nil : encRight [] = default := rfl +@[simp] private theorem encRight_cons (p : (ℕ × ℕ)) (S : List (ℕ × ℕ)) : + encRight (p :: S) = rWord p +> encRight S := rfl abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) @@ -136,91 +136,146 @@ def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := [.finWord ((leftList s.1 s.2.1).map zWord)] -lemma append_assoc_blank (a b : List (Fin 2)) (s : zB) : +private theorem append_assoc_blank (a b : List (Fin 2)) (s : zB) : (a ++ b) +> s = a +> (b +> s) := by induction a with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma evalSegRegion_zWord (L : List ℕ) : +private theorem evalSegRegion_zWord (L : List ℕ) : evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by induction L with - | nil => simp [evalSegRegion, encLeft, listblank_append_nil] + | nil => simp [evalSegRegion, encLeft_nil] | cons k rest ih => - simp only [List.map_cons, evalSegRegion, encLeft, ← ih] + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default -lemma evalSegRegion_rWord (R : List (ℕ × ℕ)) : +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by induction R with - | nil => simp [evalSegRegion, encRight, listblank_append_nil] + | nil => simp [evalSegRegion, encRight_nil] | cons p rest ih => - simp only [List.map_cons, evalSegRegion, encRight, ← ih] + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default @[simp] -lemma evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsL (m, L, R)) = encRight R := evalSegRegion_rWord R @[simp] -lemma evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : evalSegmentedHalf (segsR (m, L, R)) = encLeft (leftList m L) := evalSegRegion_zWord (leftList m L) -lemma oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by cases o with | zero => - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] | succ o => cases o <;> - simp only [oRun, ListBlank.append, WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] -lemma noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_oRun (o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (oRun o +> t) := by induction o with | zero => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, ListBlank.append] have h1 := WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) t ht 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ h1 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) | succ o ih => - simp only [oRun, ListBlank.append] + simp only [oRun_zero, oRun_succ, ListBlank.append] exact WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (1 : Fin 2) _ ih 0 (by decide) (by rw [WordRunStack.nth_cons_zero]; decide) -lemma noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : +private theorem noFactor_010_rWord (z o : ℕ) (t : zB) (ht : WordRunStack.NoFactor [0, 1, 0] t) : WordRunStack.NoFactor [0, 1, 0] (rWord (z, o) +> t) := by induction z with | zero => - simp only [rWord] + simp only [rWord_zero] exact noFactor_010_oRun o t ht | succ z ih => cases z with | zero => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 2 (by decide) ?_ rw [WordRunStack.nth_cons_succ, oRun_nth_one] decide | succ z => - simp only [rWord, ListBlank.append] at ih ⊢ + simp only [rWord_zero, rWord_succ, ListBlank.append] at ih ⊢ refine WordRunStack.noFactor_cons_of_nth_ne [0, 1, 0] (0 : Fin 2) _ ih 1 (by decide) ?_ simp only [WordRunStack.nth_cons_succ, WordRunStack.nth_cons_zero] decide -lemma noFactor_010_encRight : +private theorem noFactor_010_encRight : ∀ R : List (ℕ × ℕ), WordRunStack.NoFactor [0, 1, 0] (encRight R) | [] => WordRunStack.noFactor_default [0, 1, 0] 1 (by decide) (by decide) | (z, o) :: R => noFactor_010_rWord z o _ (noFactor_010_encRight R) -lemma segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := +theorem segsL_nowhere_dense : IsNowhereDenseHalf ValidSeg segsL := WordRunStack.isNowhereDenseHalf_of_noFactor ValidSeg segsL [0, 1, 0] (fun ⟨_, _, R⟩ _ => by rw [evalSegmentedHalf_segsL]; exact noFactor_010_encRight R) -lemma segs_len_le_three (s : SegState) (_ : ValidSeg s) : - (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 := by - simp [segsL, segsR] +/-- Canonical mode enumeration for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +private theorem zWord_ne_nil (k : ℕ) : zWord k ≠ [] := by + cases k <;> simp [zWord_zero, zWord_succ] + +private theorem zWord_ne_zero : ∀ k : ℕ, zWord k ≠ [(0 : Fin 2)] + | 0 => by simp [zWord_zero] + | n + 1 => fun h => by + dsimp only [zWord_zero, zWord_succ] at h + exact zWord_ne_nil n (List.cons.inj h).2 + +private theorem oRun_len (o : ℕ) : 2 ≤ (oRun o).length := by + induction o with + | zero => decide + | succ _ ih => simp [oRun_zero, oRun_succ]; omega + +private theorem rWord_len : ∀ p : ℕ × ℕ, 2 ≤ (rWord p).length + | (0, o) => by simp only [rWord_zero]; exact oRun_len o + | (z + 1, o) => by + have ih := rWord_len (z, o) + simp only [rWord_zero, rWord_succ, List.length_cons] + omega + +private theorem rWord_ne_nil (p : ℕ × ℕ) : rWord p ≠ [] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem rWord_ne_zero (p : ℕ × ℕ) : rWord p ≠ [(0 : Fin 2)] := by + intro h + have := rWord_len p + simp [h] at this + +private theorem segs_wf (s : SegState) (_ : ValidSeg s) : + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed) := by + refine ⟨by simp [segsL], by simp [segsR], ?_, ?_⟩ + · simp only [segsL, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact rWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact rWord_ne_zero x hx + · simp only [segsR, List.mem_singleton] + rintro _ rfl + refine ⟨?_, ?_⟩ + · rintro _ hw + rcases List.mem_map.mp hw with ⟨x, _, rfl⟩ + exact zWord_ne_nil x + · intro h + rcases List.mem_map.mp (h 0) with ⟨x, _, hx⟩ + exact zWord_ne_zero x hx @[simp] def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) @@ -235,7 +290,7 @@ def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := evalSegCfg s.1 s.2.1 s.2.2 -lemma valid_seg_modes : +theorem valid_seg_modes : ∀ m : SegMode, ∃ (q : Fin 6) (vL vR : HalfTapeView (Fin 2)), viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ ∀ s : SegState, ValidSeg s → modeOf s = m → @@ -279,7 +334,7 @@ lemma valid_seg_modes : rw [evalSegmentedHalf_segsL, evalSegmentedHalf_segsR] exact Or.inr (Or.inr rfl) -lemma segsR_boundary_aligned : +theorem segsR_boundary_aligned : ∀ s : SegState, ValidSeg s → ∃ q vL, (evalCfg s = ⟨some q, ⟨0, vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ (evalCfg s = vL <{{q}} (evalSegmentedHalf (segsR s))) ∨ @@ -316,60 +371,60 @@ def cfgHalt (L : List ℕ) (o : ℕ) (R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin @[simp] def s₀ : SegState := (.mB0, [0, 0, 0], [(0, 2)]) -lemma init_reaches_segmented_system : +private theorem init_reaches_segmented_system : (init []) [target_tm]⊢⁺ evalSegCfg .mB0 [0, 0, 0] [(0, 2)] := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl rw [h_init] - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail] + default_head, default_tail] step; step; step; step; step; step; step; step; step; step step; step; step; step; step; step; step; step; step; step step; step; step; step; step; step; step; step; step; step finish -lemma step_mAL_nil (R : List (ℕ × ℕ)) : +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L (push0R R) := by rcases R with _ | ⟨⟨z, o⟩, R⟩ <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, push0R, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mAL_succ (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mAL ((k + 1) :: L) R) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: k :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mB0_nil (L : List ℕ) : +private theorem step_mB0_nil (L : List ℕ) : (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_base (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L (push0L L)) R := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_step (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0L L) ((0, o) :: R) := by cases L <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, push0L, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((0, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (push0IterL (o + 2) L) R := by induction o generalizing L with @@ -377,143 +432,144 @@ lemma step_mB0_0_sweep (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : simp only [push0IterL] exact step_mB0_0_base L R | succ o ih => - simp only [Nat.succ_add, push0IterL] + simp only [push0IterL] exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) -lemma step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_1 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mB0 (0 :: L) ((0, o) :: R) := by cases o <;> ( - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute) + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) -lemma step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mB0_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mB0 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL L ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 1) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD0 L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_nil (R : List (ℕ × ℕ)) : +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_0 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (0 :: L) R) [target_tm]⊢⁺ evalSegCfg .mAL L ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_1 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 (1 :: L) R) [target_tm]⊢⁺ evalSegCfg .mD1 L R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mCL1_succ2 (k : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mCL1 ((k + 2) :: L) R) [target_tm]⊢⁺ evalSegCfg .mCL1 (k :: L) ((0, 0) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_nil (L : List ℕ) : +private theorem step_mD0_nil (L : List ℕ) : (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by - simp only [evalSegCfg, applyView, encLeft, encRight, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute -lemma step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_01 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_0_succ2 (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((0, o + 2) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD0_succ (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD0 L ((z + 1, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) ((z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_nil (L : List ℕ) : +private theorem step_mD1_nil (L : List ℕ) : (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_00 (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, 0) :: R)) [target_tm]⊢⁺ evalSegCfg .mD1 (1 :: L) R := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_0_succ (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((0, o + 1) :: R)) [target_tm]⊢⁺ evalSegCfg .mD0 (1 :: L) ((0, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_1_to_halt (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((1, o) :: R)) [target_tm]⊢⁺ cfgHalt (1 :: L) o R := by - simp only [evalSegCfg, cfgHalt, applyView, encLeft, encRight, zWord, rWord, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, cfgHalt, applyView, encLeft_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -lemma step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (step target_tm (cfgHalt L o R)).isNone := by - cases o <;> simp [cfgHalt, oRun, ListBlank.append, Turing.ListBlank.head_cons, step, target_tm] + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] -lemma step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem step_mD1_succ2 (z o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : (evalSegCfg .mD1 L ((z + 2, o) :: R)) [target_tm]⊢⁺ evalSegCfg .mAL L ((1, 2) :: (z, o) :: R) := by - simp only [evalSegCfg, applyView, encLeft, encRight, zWord, rWord, oRun, - ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, - zero_cons_default, default_head, default_tail]; execute + simp only [evalSegCfg, applyView, encLeft_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute -theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : +private theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : ∃ cfg', ((evalSegCfg m L R) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := by cases m with @@ -580,24 +636,25 @@ theorem segmented_step_sound (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ) · exact ⟨evalCfg (.mAL, L, (1, 2) :: (z, o) :: R), step_mD1_succ2 z o L R, Or.inl ⟨(.mAL, L, (1, 2) :: (z, o) :: R), trivial, rfl⟩⟩ -theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : +private theorem segmented_system_closed (s : SegState) (_ : ValidSeg s) : ∃ cfg', ((evalCfg s) [target_tm]⊢⁺ cfg') ∧ ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step target_tm cfg').isNone) := segmented_step_sound s.1 s.2.1 s.2.2 --- END EXPLORATORY DEFINITIONS AND LEMMAS - --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by - exact ⟨SegState, SegMode, ValidSeg, modeOf, segsL, segsR, evalCfg, - ⟨[.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1], by decide, by decide, fun m => by cases m <;> simp⟩, - segs_len_le_three, - valid_seg_modes, +/-- Explicit `IsClosedSegmentedSystem` witness for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + rw [target_eq_target_tm] + exact ⟨by decide, by decide, fun m => by cases m <;> simp [modes], + segs_wf, valid_seg_modes, Or.inl segsL_nowhere_dense, Or.inl segsL_nowhere_dense, Or.inr segsR_boundary_aligned, ⟨s₀, trivial, init_reaches_segmented_system⟩, segmented_system_closed⟩ +/-- Segmented cryptid certificate for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ +theorem is_segmented_cryptid : IsSegmentedCryptid target := + ⟨SegState, SegMode, modes, ValidSeg, modeOf, segsL, segsR, evalCfg, is_closed_segmented_system⟩ + end BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE diff --git a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean index 9ee857bd..70e4d690 100644 --- a/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.lean @@ -12,30 +12,26 @@ public import BusyBeaver.WordRunStack @[expose] public section -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.style.multiGoal false -set_option linter.deprecated false -set_option linter.flexible false /-! -# Busy Beaver Machine `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` — `is_odometer_cryptid` (`IsOdometerCryptid target_tm`) +# Busy Beaver Machine `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` (`IsOdometerCryptid`) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsOdometerCryptid` proof for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` (`target`). -/ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA" -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB -/-- Transition function for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) +private def target_tm : Machine (Fin 2) (Fin 6) | 0, 0 => some (some 1, Stmt.write 1 Dir.right) | 0, 1 => none | 1, 0 => some (some 2, Stmt.write 1 Dir.right) @@ -49,64 +45,64 @@ def target_tm : Machine (Fin 2) (Fin 6) | 5, 0 => some (some 3, Stmt.write 1 Dir.right) | 5, 1 => some (some 0, Stmt.write 1 Dir.right) --- END TRUSTED DEFINITIONS - --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem target_eq_target_tm : target = target_tm := by + funext q s + fin_cases q <;> fin_cases s <;> rfl local notation "zB" => ListBlank (Fin 2) -set_option linter.unusedSimpArgs false -set_option linter.unusedTactic false -set_option linter.unusedVariables false -set_option maxHeartbeats 2000000 -set_option maxRecDepth 10000 - -@[simp] lemma zMz (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 0 = some config := rfl -@[simp] lemma zMo (M : Machine Γ Λ) (config : Cfg Γ Λ) : multiStep M config 1 = step M config := rfl -@[simp] lemma zMs (M : Machine Γ Λ) (config : Cfg Γ Λ) (n : Nat) : + +@[simp] private theorem zMz {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) : + multiStep M config 0 = some config := rfl +@[simp] private theorem zMo {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) : + multiStep M config 1 = step M config := rfl +@[simp] private theorem zMs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (M : Machine Γ Λ) + (config : Cfg Γ Λ) (n : Nat) : multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] -@[simp] lemma z00 : (0 : Fin 2) >> default = default := by +@[simp] private theorem z00 : (0 : Fin 2) >> default = default := by apply Turing.ListBlank.ext; intro i; cases i <;> rfl -@[simp] lemma zDh : (default : zB).head = 0 := rfl -@[simp] lemma zDt : (default : zB).tail = default := rfl +@[simp] private theorem zDh : (default : zB).head = 0 := rfl +@[simp] private theorem zDt : (default : zB).tail = default := rfl -lemma zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] -lemma z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z01 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢⁺ c₂ := ⟨1, by decide, zSm tm c₁ c₂ h⟩ -lemma zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zMa {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ : Cfg Γ Λ) (n m : Nat) : multiStep tm c₁ (n + m) = (multiStep tm c₁ n).bind (fun c₂ => multiStep tm c₂ m) := by induction m with | zero => simp | succ m' ih => rw [Nat.add_succ, zMs, ih, Option.bind_assoc]; simp_rw [zMs] -lemma zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zMt {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] (tm : Machine Γ Λ) (c₁ c₂ c3 : Cfg Γ Λ) (n m : Nat) (h1 : c₁ [tm]⊢^{n} c₂) (h2 : c₂ [tm]⊢^{m} c3) : c₁ [tm]⊢^{n+m} c3 := by rw [zMa, h1]; simp [h2] -lemma zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zPs {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ : Cfg Γ Λ} (h : c₁ [tm]⊢⁺ c₂) : c₁ [tm]⊢* c₂ := by obtain ⟨n, _, hn⟩ := h; exact ⟨n, hn⟩ -lemma z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z02 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := by obtain ⟨n, n_pos, hn⟩ := h1; obtain ⟨m, hm⟩ := h2 exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c₁ c₂ c3 n m hn hm⟩ -lemma z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem z03 {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢ c₂) (h2 : c₂ [tm]⊢* c3) : c₁ [tm]⊢⁺ c3 := z02 (z01 tm c₁ c₂ h1) h2 -lemma zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem zPpp {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] {tm : Machine Γ Λ} {c₁ c₂ c3 : Cfg Γ Λ} (h1 : c₁ [tm]⊢⁺ c₂) (h2 : c₂ [tm]⊢⁺ c3) : c₁ [tm]⊢⁺ c3 := z02 h1 (zPs h2) @@ -115,32 +111,33 @@ local macro "finish" : tactic => `(tactic| exists 0 <;> fail) local macro "gstep" : tactic => `(tactic| (try refine zPs ?_) <;> refine z03 (by (try simp only [Turing.ListBlank.head_cons, zDh]); rfl) ?_ <;> - simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, Tape.write, z00, zDh, zDt]) + simp only [Turing.Tape.move, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + Tape.write, z00, zDh, zDt]) local macro "execute" : tactic => `(tactic| repeat (any_goals (first | finish | gstep))) -lemma fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by +private theorem fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by match b with | ⟨0, _⟩ => left; rfl | ⟨1, _⟩ => right; rfl -inductive OdomTok where +private inductive OdomTok where | L0 | L1 | L2 deriving DecidableEq, Repr @[simp] -def odomWord : OdomTok → List (Fin 2) +private def odomWord : OdomTok → List (Fin 2) | .L0 => [0, 0, 1, 0] | .L1 => [1, 0, 1, 0] | .L2 => [1, 1, 0] @[simp] -def encOdom : List OdomTok → zB +private def encOdom : List OdomTok → zB | [] => [1] +> default | t :: l => odomWord t +> encOdom l -lemma encOdom_non_surjective : +private theorem encOdom_non_surjective : ∃ t : zB, ∀ stk : List OdomTok, encOdom stk ≠ t := by refine ⟨default, fun stk h => ?_⟩ cases stk with @@ -153,7 +150,8 @@ lemma encOdom_non_surjective : | L0 => have h1 : (encOdom (.L0 :: tl)).tail.tail.head = (default : zB).tail.tail.head := congrArg (fun x => x.tail.tail.head) h - simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, zDt, zDh] at h1 + simp only [encOdom, odomWord, ListBlank.append, ListBlank.tail_cons, ListBlank.head_cons, + zDt, zDh] at h1 revert h1; decide | L1 => have h1 : (encOdom (.L1 :: tl)).head = (default : zB).head := congrArg ListBlank.head h @@ -164,74 +162,77 @@ lemma encOdom_non_surjective : simp only [encOdom, odomWord, ListBlank.append, ListBlank.head_cons, zDh] at h1 revert h1; decide -@[simp] def state_R (_ : List OdomTok) : Fin 6 := 3 +@[simp] private def state_R (_ : List OdomTok) : Fin 6 := 3 -@[simp] def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := +@[simp] private def cfg_R (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := evalOdomR .leftOdom (state_R l) [1, 0] (encOdom l) r -@[simp] def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := +@[simp] private def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := evalOdomL .leftOdom 1 [1, 0] (encOdom l) r -def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := +private def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w -def init_w0 : zB := (0 : Fin 2) >> 1 >> 0 >> 1 >> default +private def init_w0 : zB := (0 : Fin 2) >> 1 >> 0 >> 1 >> default -lemma step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by +private theorem step_init : (init []) [target_tm]⊢⁺ cfg_R [] init_w0 := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl - rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append, z00]; execute + rw [h_init]; simp only [cfg_R, state_R, init_w0, evalOdomR, encOdom, ListBlank.append + ]; execute -lemma step_R_0 (l : List OdomTok) (r : zB) : +private theorem step_R_0 (l : List OdomTok) (r : zB) : (cfg_R l ((0 : Fin 2) >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append]; execute -lemma step_R_100 (l : List OdomTok) (r : zB) : +private theorem step_R_100 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 0 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L2 :: l) r := by - simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append]; execute -lemma step_R_11 (l : List OdomTok) (r : zB) : +private theorem step_R_11 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 1 >> r)) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, ListBlank.append]; execute -lemma step_R_1010 (l : List OdomTok) (r : zB) : +private theorem step_R_1010 (l : List OdomTok) (r : zB) : (cfg_R l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r)) [target_tm]⊢⁺ cfg_R (.L0 :: l) r := by - simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_L0 (l : List OdomTok) (r : zB) : +private theorem step_L_L0 (l : List OdomTok) (r : zB) : (cfg_L (.L0 :: l) r) [target_tm]⊢⁺ cfg_R (.L1 :: l) r := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, odomWord, ListBlank.append + ]; execute -lemma step_L_L1 (l : List OdomTok) (r : zB) : +private theorem step_L_L1 (l : List OdomTok) (r : zB) : (cfg_L (.L1 :: l) r) [target_tm]⊢⁺ cfg_L l ((1 : Fin 2) >> 0 >> 1 >> 0 >> r) := by - simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_L2 (l : List OdomTok) (r : zB) : +private theorem step_L_L2 (l : List OdomTok) (r : zB) : (cfg_L (.L2 :: l) r) [target_tm]⊢⁺ cfg_L l ((0 : Fin 2) >> 1 >> 0 >> r) := by - simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append, z00]; execute + simp only [cfg_L, evalOdomL, encOdom, odomWord, ListBlank.append]; execute -lemma step_L_nil (r : zB) : +private theorem step_L_nil (r : zB) : (cfg_L [] r) [target_tm]⊢⁺ cfg_R [] ((1 : Fin 2) >> 0 >> r) := by - simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append, z00]; execute + simp only [cfg_L, cfg_R, state_R, evalOdomL, evalOdomR, encOdom, ListBlank.append]; execute @[simp] -def cap : List OdomTok → Nat +private def cap : List OdomTok → Nat | [] => 0 | .L0 :: l => 2 * cap l + 1 | .L1 :: l => 2 * cap l | .L2 :: l => cap l / 3 @[simp] -def dec_fuel : Nat → List OdomTok → List OdomTok +private def dec_fuel : Nat → List OdomTok → List OdomTok | 0, l => l | _ + 1, [] => [] | _ + 1, .L0 :: l => .L1 :: l | n + 1, .L1 :: l => .L0 :: dec_fuel n l | n + 1, .L2 :: l => .L2 :: dec_fuel n (dec_fuel n (dec_fuel n l)) -def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l +private def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l @[simp] -lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := by +private theorem length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.length := + by induction n generalizing l with | zero => rfl | succ n ih => @@ -240,16 +241,16 @@ lemma length_dec_fuel (n : Nat) (l : List OdomTok) : (dec_fuel n l).length = l.l | cons t tl => cases t <;> simp [dec_fuel, ih] @[simp] -lemma length_dec (l : List OdomTok) : (dec l).length = l.length := +private theorem length_dec (l : List OdomTok) : (dec l).length = l.length := length_dec_fuel l.length l -@[simp] lemma dec_nil : dec [] = [] := rfl -@[simp] lemma dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl -@[simp] lemma dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl -@[simp] lemma dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by +@[simp] private theorem dec_nil : dec [] = [] := rfl +@[simp] private theorem dec_L0 (l : List OdomTok) : dec (.L0 :: l) = .L1 :: l := rfl +@[simp] private theorem dec_L1 (l : List OdomTok) : dec (.L1 :: l) = .L0 :: dec l := rfl +@[simp] private theorem dec_L2 (l : List OdomTok) : dec (.L2 :: l) = .L2 :: dec (dec (dec l)) := by simp only [dec, List.length_cons, dec_fuel, length_dec_fuel] -lemma cap_dec_aux (n : Nat) : +private theorem cap_dec_aux (n : Nat) : ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → cap (dec l) = cap l - 1 := by induction n with | zero => @@ -277,10 +278,10 @@ lemma cap_dec_aux (n : Nat) : have ih3 := ih (dec (dec l)) hlen2 (by omega) rw [ih3, ih2, ih1]; omega -lemma cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := +private theorem cap_dec (l : List OdomTok) (h : cap l ≥ 1) : cap (dec l) = cap l - 1 := cap_dec_aux l.length l (Nat.le_refl _) h -lemma runHL_dec_aux (n : Nat) : +private theorem runHL_dec_aux (n : Nat) : ∀ (l : List OdomTok) (r : zB), l.length ≤ n → cap l ≥ 1 → (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := by induction n with @@ -318,30 +319,30 @@ lemma runHL_dec_aux (n : Nat) : (zPpp (ih (dec (dec l)) _ hlen2 (by omega)) (step_R_100 (dec (dec (dec l))) r)))))) -lemma runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : +private theorem runHL_dec (l : List OdomTok) (r : zB) (h : cap l ≥ 1) : (cfg_L l r) [target_tm]⊢⁺ cfg_R (dec l) r := runHL_dec_aux l.length l r (Nat.le_refl _) h @[simp] -def mod3Bits (c : Nat) : List (Fin 2) := +private def mod3Bits (c : Nat) : List (Fin 2) := if c % 3 = 0 then [0, 1, 0] else if c % 3 = 1 then [1, 1, 0] else [1, 0, 0] @[simp] -def drain : List OdomTok → List (Fin 2) +private def drain : List OdomTok → List (Fin 2) | [] => [1, 0] | .L0 :: tl => drain tl ++ [1, 0, 1, 0] | .L1 :: tl => drain tl ++ [1, 0, 1, 0] | .L2 :: tl => drain tl ++ mod3Bits (cap tl) -lemma drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] +private theorem drain_ne_nil : ∀ l : List OdomTok, drain l ≠ [] | [] => by decide | .L0 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ | .L1 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ | .L2 :: tl => List.append_ne_nil_of_left_ne_nil (drain_ne_nil tl) _ -lemma drain_dec_aux (n : Nat) : +private theorem drain_dec_aux (n : Nat) : ∀ l : List OdomTok, l.length ≤ n → cap l ≥ 1 → drain (dec l) = drain l := by induction n with | zero => @@ -377,16 +378,16 @@ lemma drain_dec_aux (n : Nat) : rw [hrem] rw [ih3, ih2, ih1, hmod] -lemma drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := +private theorem drain_dec (l : List OdomTok) (hcap : cap l ≥ 1) : drain (dec l) = drain l := drain_dec_aux l.length l (Nat.le_refl _) hcap -lemma append_list_assoc (xs ys : List (Fin 2)) (w : zB) : +private theorem append_list_assoc (xs ys : List (Fin 2)) (w : zB) : (xs ++ ys) +> w = xs +> (ys +> w) := by induction xs with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma run_drain_aux (n : Nat) : +private theorem run_drain_aux (n : Nat) : ∀ (l : List OdomTok) (w : zB), l.length ≤ n → cap l = 0 → (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := by induction n with @@ -440,14 +441,14 @@ lemma run_drain_aux (n : Nat) : (zPpp (runHL_dec (dec tl) ((1 : Fin 2) >> 1 >> 0 >> w) (by omega)) (zPpp (step_R_11 (dec (dec tl)) ((0 : Fin 2) >> w)) h_ih)))) -lemma run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : +private theorem run_drain (l : List OdomTok) (w : zB) (hcap : cap l = 0) : (cfg_L l w) [target_tm]⊢⁺ cfg_R [] (drain l +> w) := run_drain_aux l.length l w (Nat.le_refl _) hcap -def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := +private def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) -lemma stepL_state_sound (l : List OdomTok) (w : zB) : +private theorem stepL_state_sound (l : List OdomTok) (w : zB) : (cfg_L l w) [target_tm]⊢⁺ cfg_R (stepL_state l w).1 (stepL_state l w).2 := by unfold stepL_state split_ifs with hcap @@ -455,7 +456,7 @@ lemma stepL_state_sound (l : List OdomTok) (w : zB) : · have hz : cap l = 0 := by omega exact run_drain l w hz -lemma step_R_partition (l : List OdomTok) (w : zB) +private theorem step_R_partition (l : List OdomTok) (w : zB) (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : (∃ t w', (cfg_R l w) [target_tm]⊢⁺ cfg_R (t :: l) w') ∨ (∃ w', (cfg_R l w) [target_tm]⊢⁺ cfg_L l w') ∨ @@ -491,7 +492,7 @@ lemma step_R_partition (l : List OdomTok) (w : zB) · rw [h1] at hg0; nomatch hg0 · rw [h11] at hg1; nomatch hg1 -lemma step_R_closed (l : List OdomTok) (w : zB) +private theorem step_R_closed (l : List OdomTok) (w : zB) (hguard : w.head = 0 ∨ (w.tail.head = 0 ∧ (w.tail.tail.head = 0 ∨ w.tail.tail.tail.head = 0))) : ∃ cfg', ((cfg_R l w) [target_tm]⊢⁺ cfg') ∧ (IsInOdomSystem cfg' ∨ (step target_tm cfg').isNone) := by @@ -502,15 +503,14 @@ lemma step_R_closed (l : List OdomTok) (w : zB) Or.inl ⟨(stepL_state l w').1, (stepL_state l w').2, rfl⟩⟩ · exact ⟨cfg_halt, hhalt, Or.inr hnone⟩ -lemma step_init_nontrivial : (init []) [target_tm]⊢⁺ cfg_R [.L0, .L0] default := by +private theorem step_init_nontrivial : (init []) [target_tm]⊢⁺ cfg_R [.L0, .L0] default := by have h_init : (init [] : Cfg (Fin 2) (Fin 6)) = ((default : zB) {{0}}> (default : zB)) := rfl - rw [h_init]; simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append, z00]; execute - --- END EXPLORATORY DEFINITIONS AND LEMMAS + rw [h_init]; simp only [cfg_R, state_R, evalOdomR, encOdom, odomWord, ListBlank.append + ]; execute --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) -theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by +theorem is_odometer_cryptid : IsOdometerCryptid target := by + rw [target_eq_target_tm] refine ⟨OdomTok, .leftOdom, state_R, 1, [1, 0], [1, 0], [1], odomWord, encOdom, cap, dec, (fun _ => []), drain, IsInOdomSystem, ?_, ?_, ?_, rfl, ?_, encOdom_non_surjective, rfl, ?_, length_dec, cap_dec, runHL_dec, (fun stk _ => drain_ne_nil stk), run_drain, diff --git a/BusyBeaver/BB6/Accelerations/README.md b/BusyBeaver/BB6/Accelerations/README.md index 2264395b..9a78baf7 100644 --- a/BusyBeaver/BB6/Accelerations/README.md +++ b/BusyBeaver/BB6/Accelerations/README.md @@ -4,7 +4,7 @@ This directory contains formal Lean 4 specifications and kernel-verified reducti 1. **15 Structural Stack, Odometer, and Transducer Reductions** formalized under the three structural reduction predicates defined in [`BusyBeaver/Defs.lean`](../../Defs.lean)—`HasStackReduction` (12 machines: 9 `bbchallenge` Wiki machines and 3 Halving Tower holdouts), `HasOdometerReduction` (2 machines: Beaver Math Olympiad Problems 10 and 11), and `HasTransducerReduction` (1 machine: *Bell eats counter*). 2. **20 Open `BB(6)` Acceleration Problems** certified via `IsValidAcceleration` and `IsHalt target ↔ CollatzHalts next start` (with [`1RB1LD_0RC0LF_1LD1RE_0LA0RB_0RD1RB_0LD---`](./M_1RB1LD_0RC0LF_1LD1RE_0LA0RB_0RD1RB_0LDHHH.lean) additionally proved under `HasOdometerReduction`). Each open problem states a self-contained initial state $s_0$ (`start`) and accelerated transition map $T$ (`next`) over finite sequences and non-negative integers: the corresponding Turing machine halts from the blank tape if and only if iterating $T$ from $s_0$ eventually reaches $\mathrm{Halt}$ (`none`). For **13** of the 20 machines, we additionally prove a **higher-level Poincaré / epoch acceleration** $(s_{0,\mathrm{HL}}, T_{\mathrm{HL}})$ (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) that eliminates an entire stack, mixed-radix odometer, or auxiliary mode by restricting to a canonical return section or contracting full multi-bounce epochs. -3. **21 Hard Holdout Cryptid Machines** formalized under `IsSegmentedCryptid` (10 machines), `IsStackCryptid` (9 machines), and `IsOdometerCryptid` (2 machines), capturing the full remaining frontier of BB(6) hard holdouts. +3. **21 Hard Holdout Cryptid Machines** formalized under `IsSegmentedCryptid` (11 machines, each also exporting its pinned `is_closed_segmented_system` theorem), `IsStackCryptid` (8 machines), and `IsOdometerCryptid` (2 machines), capturing the Hard holdout frontier alongside `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` in `BusyBeaver/BB6/`. > **Hardness & Formal Evidence.** The Collatz-like stacked cryptids among these machines (`#391`, `#129`, `#660`/`#659`/`#209`/`#680`/`#480`, `#549`/`#80`, `#33`, `#85`/`#285`/`#490`/`#500`) are classified, with heuristic hazards and the resolved case `#72`, in [`../Hardness.lean`](../Hardness.lean) (`BusyBeaver.BB6.Hardness`), and kernel-checked live-hazard witnesses and halting residue classes for the accelerated problems are proved in [`../HardnessEvidence.lean`](../HardnessEvidence.lean) (`BusyBeaver.BB6.HardnessEvidence`). @@ -831,7 +831,7 @@ where $\mathcal{D}$ (`stepD`) peels $[(0, 1), (0, 1)]$ pairs on $L$ and, on $[(0 ## 4. Hard Holdout Cryptid Machines (21 Machines) -The remaining frontier of hard holdout Turing machines in BB(6) whose blank-tape trajectories enter closed dynamic schemas over partitioned half-tapes (`IsSegmentedCryptid`), multi-layer stack systems (`IsStackCryptid`), or mixed-radix odometer bitstreams (`IsOdometerCryptid`): +The remaining frontier of hard holdout Turing machines in BB(6) whose blank-tape trajectories enter closed dynamic schemas over partitioned half-tapes (`IsSegmentedCryptid`, 11 machines with explicit `is_closed_segmented_system` theorems), multi-layer stack systems (`IsStackCryptid`, 8 machines), or mixed-radix odometer bitstreams (`IsOdometerCryptid`, 2 machines), alongside `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` in [`BusyBeaver/BB6/`](../README.md): | Machine (`bbchallenge` RLE) | Predicate | Lean 4 Proof | | :--- | :--- | :--- | diff --git a/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean b/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean index f0dcacbc..e551f77f 100644 --- a/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean +++ b/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean @@ -8,1559 +8,698 @@ public import BusyBeaver.Basic public import BusyBeaver.Bridge /-! -# Busy Beaver Machine `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` — `is_cryptid` (`IsCryptid target_tm`) +# Busy Beaver Holdout `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` (#424) -This file imports shared trusted definitions from `BusyBeaver.Basic` -and defines `target_tm` for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. Do not modify the trusted -definitions section or the goal theorem signature. +Formal `IsClosedPatternSet`, `HasCollatzReduction`, `IsCryptid`, and `IsValidAcceleration` +proofs for the 6-state, 2-symbol Busy Beaver holdout `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` +(bbchallenge holdout #424, discovered by Racheline). + +Starting from the blank tape (`init []`), the trajectory enters the closed 2-pattern system +`ps = [(pat_A, .true), (pat_Run, .true)]` at `A(2, 0, 1)` in 12 steps, where: +$$A(a, c, d) := 0^\infty\,1^a\,\mathrm{A}{>}\,(10)^c\,1^{d+1}\,0^\infty, \qquad + \mathrm{Run}(a) := 0^\infty\,1^a\,\mathrm{D}{>}\,0^\infty.$$ + +## Collatz-like Acceleration Rules + +- `Run(a) -> Run(a + 1)` +- `A(a + 2, c, d) -> A(a, c + 1, d)` +- `A(0, c, 0) -> Halt` +- `A(0, c, 1) -> A(2*c + 1, 0, 0)` +- `A(0, c, d + 2) -> A(2*c + 1, 1, d)` +- `A(1, 2*k, 0) -> Run(1)` +- `A(1, 2*k + 1, 0) -> A(2, 0, 6*k + 7)` +- `A(1, 2*k, 1) -> A(2, 0, 6*k + 6)` +- `A(1, 2*k + 1, d + 1) -> A(6*k + 8, 0, d)` +- `A(1, 2*k, d + 2) -> A(6*k + 7, 0, d)` -/ @[expose] public section -open Mathlib Relation Nat Turing BusyBeaver - namespace BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE --- BEGIN TRUSTED DEFINITIONS (DO NOT MODIFY) +open SixState Turing + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +/-- Pattern `pat_A` matching `A(a, c, d) := 0^∞ 1^a A> (10)^c 1^(d+1) 0^∞`. -/ +def pat_A : TapePattern (Fin 2) (Fin 6) := + { left := .rep [1] 0 .default + head := some A + right := .rep [1, 0] 1 (.sym 1 (.rep [1] 2 .default)) } + +/-- Pattern `pat_Run` matching `Run(a) := 0^∞ 1^a D> 0^∞`. -/ +def pat_Run : TapePattern (Fin 2) (Fin 6) := + { left := .rep [1] 0 .default + head := some D + right := .default } + +/-- Explicit closed 2-pattern invariant certificate (`ps.length ≤ 16`). -/ +def ps : TapePatternSet (Fin 2) (Fin 6) := + [(pat_A, .true), (pat_Run, .true)] + +/-- Symbolic states for the closed acceleration of #424. -/ +inductive State where + /-- $A(a, c, d) := 0^\infty\,1^a\,\mathrm{A}{>}\,(10)^c\,1^{d+1}\,0^\infty$. -/ + | A (a c d : ℕ) + /-- $\mathrm{Run}(a) := 0^\infty\,1^a\,\mathrm{D}{>}\,0^\infty$. -/ + | Run (a : ℕ) + deriving DecidableEq, Repr + +/-- Entry state from the blank tape, reached after 12 raw steps. -/ +def start : State := .A 2 0 1 + +/-- Configuration encoder for `State`. -/ +def encode : State → Cfg (Fin 2) (Fin 6) + | .A a c d => + Cfg.headRight A (([1] : List (Fin 2)) ^ a +> default) + (([1, 0] : List (Fin 2)) ^ c +> + ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ d +> default))) + | .Run a => + Cfg.headRight D (([1] : List (Fin 2)) ^ a +> default) default + +/-- Deterministic accelerated transition function on `State`. -/ +def next : State → Option State + | .Run a => some (.Run (a + 1)) + | .A (a + 2) c d => some (.A a (c + 1) d) + | .A 0 _ 0 => none + | .A 0 c 1 => some (.A (2 * c + 1) 0 0) + | .A 0 c (d + 2) => some (.A (2 * c + 1) 1 d) + | .A 1 c 0 => + if c % 2 = 0 then some (.Run 1) else some (.A 2 0 (3 * c + 4)) + | .A 1 c 1 => + if c % 2 = 0 then some (.A 2 0 (3 * c + 6)) else some (.A (3 * c + 5) 0 0) + | .A 1 c (d + 2) => + if c % 2 = 0 then some (.A (3 * c + 7) 0 d) else some (.A (3 * c + 5) 0 (d + 1)) + +private theorem target_A_0 : target A 0 = some (some B, Stmt.write 1 Dir.right) := rfl +private theorem target_A_1 : target A 1 = some (some E, Stmt.write 1 Dir.left) := rfl +private theorem target_B_0 : target B 0 = some (some C, Stmt.write 0 Dir.left) := rfl +private theorem target_B_1 : target B 1 = some (some B, Stmt.write 0 Dir.left) := rfl +private theorem target_C_0 : target C 0 = some (some D, Stmt.write 1 Dir.right) := rfl +private theorem target_C_1 : target C 1 = some (some C, Stmt.write 1 Dir.left) := rfl +private theorem target_D_0 : target D 0 = some (some D, Stmt.write 1 Dir.right) := rfl +private theorem target_D_1 : target D 1 = some (some A, Stmt.write 1 Dir.right) := rfl +private theorem target_E_0 : target E 0 = some (some F, Stmt.write 1 Dir.right) := rfl +private theorem target_E_1 : target E 1 = some (some A, Stmt.write 0 Dir.left) := rfl +private theorem target_F_0 : target F 0 = none := rfl +private theorem target_F_1 : target F 1 = some (some E, Stmt.write 1 Dir.right) := rfl + +local macro "mstep" : tactic => + `(tactic| ( + simp only [step, Cfg.headRight, Cfg.headLeft, + target_A_0, target_A_1, target_B_0, target_B_1, + target_C_0, target_C_1, target_D_0, target_D_1, + target_E_0, target_E_1, target_F_0, target_F_1, + list_pow_zero, list_pow_succ, List.cons_append, List.singleton_append, List.nil_append, + Tape.write, Tape.move, ListBlank.append_nil, ListBlank.append_cons, + ListBlank.head_cons, ListBlank.tail_cons, + ListBlank.cons_zero_default, ListBlank.cons_default_default, + ListBlank.head_default_fin, ListBlank.tail_default, Option.map] + try rfl)) + +private theorem pow_zeros_append_default : + ∀ n : ℕ, (([0] : List (Fin 2)) ^ n) +> (default : ListBlank (Fin 2)) = default + | 0 => rfl + | n + 1 => by + simp only [list_pow_succ, List.singleton_append, ListBlank.append_cons, + pow_zeros_append_default n, ListBlank.cons_zero_default] + +private theorem pow10_append_one : + ∀ (c : ℕ) (R : ListBlank (Fin 2)), + ([1, 0] : List (Fin 2)) ^ c +> ((1 : Fin 2) >> R) = + (1 : Fin 2) >> (([0, 1] : List (Fin 2)) ^ c +> R) + | 0, _ => rfl + | c + 1, R => by + simp only [list_pow_succ, List.cons_append, List.nil_append, ListBlank.append_cons, + pow10_append_one c R] + +private theorem pow01_split_even : + ∀ (k : ℕ) (R : ListBlank (Fin 2)), + ([0, 1] : List (Fin 2)) ^ (2 * k + 1) +> R = + ([0, 1, 0, 1] : List (Fin 2)) ^ k +> ((0 : Fin 2) >> ((1 : Fin 2) >> R)) + | 0, _ => by simp [list_pow_zero, list_pow_succ] + | k + 1, R => by + have h : 2 * (k + 1) + 1 = (2 * k + 1) + 1 + 1 := by omega + rw [h, list_pow_succ ([0, 1]), list_pow_succ ([0, 1]), list_pow_succ ([0, 1, 0, 1])] + simp only [List.cons_append, List.nil_append, ListBlank.append_cons, pow01_split_even k R] + +private theorem pow01_split_odd : + ∀ (k : ℕ) (R : ListBlank (Fin 2)), + ([0, 1] : List (Fin 2)) ^ (2 * k + 2) +> R = + ([0, 1, 0, 1] : List (Fin 2)) ^ (k + 1) +> R + | 0, _ => by simp [list_pow_succ, list_pow_zero] + | k + 1, R => by + have h : 2 * (k + 1) + 2 = (2 * k + 2) + 1 + 1 := by omega + rw [h, list_pow_succ ([0, 1]), list_pow_succ ([0, 1]), list_pow_succ ([0, 1, 0, 1])] + simp only [List.cons_append, List.nil_append, ListBlank.append_cons, pow01_split_odd k R] + +private theorem append_sym_pow (x : Fin 2) : + ∀ (n : ℕ) (R : ListBlank (Fin 2)), + (([x] : List (Fin 2)) ^ n) +> (x >> R) = ([x] : List (Fin 2)) ^ (n + 1) +> R + | n, R => by + simpa only [list_pow_one, ListBlank.append_cons, ListBlank.append_nil] using + (ListBlank.append_pow_succ' [x] n R) + +private theorem reachesStar_F_10 : + ∀ (c n : ℕ) (L R : ListBlank (Fin 2)), + ReachesStar target + (Cfg.headRight F (([1] : List (Fin 2)) ^ n +> L) (([1, 0] : List (Fin 2)) ^ c +> R)) + (Cfg.headRight F (([1] : List (Fin 2)) ^ (n + 2 * c) +> L) R) + | 0, _, _, _ => ReachesStar.refl _ _ + | c + 1, n, L, R => by + have h1 : + step target + (Cfg.headRight F (([1] : List (Fin 2)) ^ n +> L) + (([1, 0] : List (Fin 2)) ^ (c + 1) +> R)) = + some (Cfg.headRight E (([1] : List (Fin 2)) ^ (n + 1) +> L) + ((0 : Fin 2) >> (([1, 0] : List (Fin 2)) ^ c +> R))) := by + mstep + have h2 : + step target + (Cfg.headRight E (([1] : List (Fin 2)) ^ (n + 1) +> L) + ((0 : Fin 2) >> (([1, 0] : List (Fin 2)) ^ c +> R))) = + some (Cfg.headRight F (([1] : List (Fin 2)) ^ (n + 2) +> L) + (([1, 0] : List (Fin 2)) ^ c +> R)) := by + mstep + refine ReachesStar.head h1 (ReachesStar.head h2 ?_) + simpa only [Nat.add_assoc, show 2 + 2 * c = 2 * (c + 1) from by omega] using + reachesStar_F_10 c (n + 2) L R + +private theorem sweep_B_left : + ∀ (n : ℕ) (L R : ListBlank (Fin 2)), + ReachesStar target + (Cfg.headLeft B (([1] : List (Fin 2)) ^ n +> L) R) + (Cfg.headLeft B L (([0] : List (Fin 2)) ^ n +> R)) + | 0, _, _ => ReachesStar.refl _ _ + | n + 1, L, R => by + have h1 : + step target (Cfg.headLeft B (([1] : List (Fin 2)) ^ (n + 1) +> L) R) = + some (Cfg.headLeft B (([1] : List (Fin 2)) ^ n +> L) ((0 : Fin 2) >> R)) := by + mstep + refine ReachesStar.head h1 ?_ + have ih := sweep_B_left n L ((0 : Fin 2) >> R) + simpa only [append_sym_pow] using ih + +private theorem sweep_D_right : + ∀ (n m : ℕ) (L R : ListBlank (Fin 2)), + ReachesStar target + (Cfg.headRight D (([1] : List (Fin 2)) ^ m +> L) (([0] : List (Fin 2)) ^ n +> R)) + (Cfg.headRight D (([1] : List (Fin 2)) ^ (m + n) +> L) R) + | 0, _, _, _ => ReachesStar.refl _ _ + | n + 1, m, L, R => by + have h1 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ m +> L) + (([0] : List (Fin 2)) ^ (n + 1) +> R)) = + some (Cfg.headRight D (([1] : List (Fin 2)) ^ (m + 1) +> L) + (([0] : List (Fin 2)) ^ n +> R)) := by + mstep + refine ReachesStar.head h1 ?_ + simpa only [Nat.add_assoc, Nat.add_comm 1 n] using sweep_D_right n (m + 1) L R + +private theorem sweep_C_left : + ∀ (n : ℕ) (L R : ListBlank (Fin 2)), + ReachesStar target + (Cfg.headLeft C (([1] : List (Fin 2)) ^ n +> L) R) + (Cfg.headLeft C L (([1] : List (Fin 2)) ^ n +> R)) + | 0, _, _ => ReachesStar.refl _ _ + | n + 1, L, R => by + have h1 : + step target (Cfg.headLeft C (([1] : List (Fin 2)) ^ (n + 1) +> L) R) = + some (Cfg.headLeft C (([1] : List (Fin 2)) ^ n +> L) ((1 : Fin 2) >> R)) := by + mstep + refine ReachesStar.head h1 ?_ + have ih := sweep_C_left n L ((1 : Fin 2) >> R) + simpa only [append_sym_pow] using ih + +private theorem loop_0101_step (m : ℕ) (R : ListBlank (Fin 2)) : + ReachesPlus target + (Cfg.headRight A (([1] : List (Fin 2)) ^ m +> default) (([0, 1, 0, 1] : List (Fin 2)) +> R)) + (Cfg.headRight A (([1] : List (Fin 2)) ^ (m + 6) +> default) R) := by + have h1 : + step target + (Cfg.headRight A (([1] : List (Fin 2)) ^ m +> default) + (([0, 1, 0, 1] : List (Fin 2)) +> R)) = + some (Cfg.headRight B (([1] : List (Fin 2)) ^ (m + 1) +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + have h2 : + step target + (Cfg.headRight B (([1] : List (Fin 2)) ^ (m + 1) +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) = + some (Cfg.headLeft B (([1] : List (Fin 2)) ^ (m + 1) +> default) + ((0 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + have hB := + sweep_B_left (m + 1) default ((0 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R))) + have hB' : + ReachesStar target + (Cfg.headLeft B (([1] : List (Fin 2)) ^ (m + 1) +> default) + ((0 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) + (Cfg.headLeft B default (([0] : List (Fin 2)) ^ (m + 3) +> ((1 : Fin 2) >> R))) := by + rw [append_sym_pow (0 : Fin 2) (m + 1) ((0 : Fin 2) >> ((1 : Fin 2) >> R)), + append_sym_pow (0 : Fin 2) (m + 2) ((1 : Fin 2) >> R)] at hB + exact hB + have h3 : + step target + (Cfg.headLeft B default (([0] : List (Fin 2)) ^ (m + 3) +> ((1 : Fin 2) >> R))) = + some (Cfg.headLeft C default (([0] : List (Fin 2)) ^ (m + 4) +> ((1 : Fin 2) >> R))) := by + mstep + have h4 : + step target + (Cfg.headLeft C default (([0] : List (Fin 2)) ^ (m + 4) +> ((1 : Fin 2) >> R))) = + some (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([0] : List (Fin 2)) ^ (m + 4) +> ((1 : Fin 2) >> R))) := by + mstep + have hD := sweep_D_right (m + 4) 1 default ((1 : Fin 2) >> R) + have hD' : + ReachesStar target + (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([0] : List (Fin 2)) ^ (m + 4) +> ((1 : Fin 2) >> R))) + (Cfg.headRight D (([1] : List (Fin 2)) ^ (m + 5) +> default) ((1 : Fin 2) >> R)) := by + simpa only [Nat.add_comm 1 (m + 4)] using hD + have h5 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ (m + 5) +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ (m + 6) +> default) R) := by + mstep + exact ReachesPlus.head h1 (ReachesStar.head h2 + (hB'.trans (ReachesStar.head h3 (ReachesStar.head h4 (hD'.trans (ReachesStar.single h5)))))) + +private theorem loop_0101 : + ∀ (k m : ℕ) (R : ListBlank (Fin 2)), + ReachesStar target + (Cfg.headRight A (([1] : List (Fin 2)) ^ m +> default) + (([0, 1, 0, 1] : List (Fin 2)) ^ k +> R)) + (Cfg.headRight A (([1] : List (Fin 2)) ^ (m + 6 * k) +> default) R) + | 0, _, _ => ReachesStar.refl _ _ + | k + 1, m, R => by + have hk : + (([0, 1, 0, 1] : List (Fin 2)) ^ (k + 1) +> R) = + ([0, 1, 0, 1] : List (Fin 2)) +> (([0, 1, 0, 1] : List (Fin 2)) ^ k +> R) := by + simp only [list_pow_succ, ListBlank.append_assoc] + rw [hk] + refine (loop_0101_step m _).to_star.trans ?_ + simpa only [Nat.add_assoc, show 6 + 6 * k = 6 * (k + 1) from by omega] using + loop_0101 k (m + 6) R + +private theorem step_Run (a : ℕ) : + ReachesPlus target (encode (.Run a)) (encode (.Run (a + 1))) := + ReachesPlus.single (by simp only [encode]; mstep) + +private theorem step_A_ge2 (a c d : ℕ) : + ReachesPlus target (encode (.A (a + 2) c d)) (encode (.A a (c + 1) d)) := by + simp only [encode] + rw [pow10_append_one] + set R := ([0, 1] : List (Fin 2)) ^ c +> (([1] : List (Fin 2)) ^ d +> default) + have h1 : + step target + (Cfg.headRight A (([1] : List (Fin 2)) ^ (a + 2) +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headLeft E (([1] : List (Fin 2)) ^ (a + 2) +> default) ((1 : Fin 2) >> R)) := by + mstep + have h2 : + step target + (Cfg.headLeft E (([1] : List (Fin 2)) ^ (a + 2) +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ a +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + refine ReachesPlus.head h1 (ReachesStar.single ?_) + simpa only [R, list_pow_succ, List.cons_append, List.nil_append, ListBlank.append_cons, + ← pow10_append_one] using h2 + +private theorem step_A0_to_F (c : ℕ) (R : ListBlank (Fin 2)) : + ReachesPlus target + (Cfg.headRight A default (([1, 0] : List (Fin 2)) ^ c +> ((1 : Fin 2) >> R))) + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) ((1 : Fin 2) >> R)) := by + rw [pow10_append_one] + have h1 : + step target (Cfg.headRight A default ((1 : Fin 2) >> (([0, 1] : List (Fin 2)) ^ c +> R))) = + some (Cfg.headLeft E default ((1 : Fin 2) >> (([0, 1] : List (Fin 2)) ^ c +> R))) := by + mstep + have h2 : + step target (Cfg.headLeft E default ((1 : Fin 2) >> (([0, 1] : List (Fin 2)) ^ c +> R))) = + some (Cfg.headRight F (([1] : List (Fin 2)) ^ 1 +> default) + (([1, 0] : List (Fin 2)) ^ c +> ((1 : Fin 2) >> R))) := by + rw [pow10_append_one] + mstep + have hF := reachesStar_F_10 c 1 default ((1 : Fin 2) >> R) + have hF' : + ReachesStar target + (Cfg.headRight F (([1] : List (Fin 2)) ^ 1 +> default) + (([1, 0] : List (Fin 2)) ^ c +> ((1 : Fin 2) >> R))) + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) ((1 : Fin 2) >> R)) := by + simpa only [Nat.add_comm 1 (2 * c)] using hF + exact ReachesPlus.head h1 (ReachesStar.head h2 hF') + +private theorem step_A0_c0_halt (c : ℕ) : + ∃ cfg', ReachesPlus target (encode (.A 0 c 0)) cfg' ∧ (step target cfg').isNone := by + simp only [encode, list_pow_zero, ListBlank.append_nil] + refine ⟨Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 3) +> default) default, ?_, ?_⟩ + · have hF := step_A0_to_F c default + have h1 : + step target + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> default)) = + some (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) default) := by + mstep + have h2 : + step target + (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) default) = + some (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 3) +> default) default) := by + mstep + exact hF.trans_star (ReachesStar.head h1 (ReachesStar.single h2)) + · mstep + +private theorem step_A0_c1 (c : ℕ) : + ReachesPlus target (encode (.A 0 c 1)) (encode (.A (2 * c + 1) 0 0)) := by + simp only [encode, list_pow_zero, ListBlank.append_nil] + have hF := step_A0_to_F c ((1 : Fin 2) >> default) + have h1 : + step target + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> ((1 : Fin 2) >> default))) = + some (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) + ((1 : Fin 2) >> default)) := by + mstep + have h2 : + step target + (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) + ((1 : Fin 2) >> default)) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> default)) := by + mstep + exact hF.trans_star (ReachesStar.head h1 (ReachesStar.single h2)) + +private theorem step_A0_cd2 (c d : ℕ) : + ReachesPlus target (encode (.A 0 c (d + 2))) (encode (.A (2 * c + 1) 1 d)) := by + simp only [encode, list_pow_zero, ListBlank.append_nil] + let R := ([1] : List (Fin 2)) ^ d +> default + have hF := step_A0_to_F c ((1 : Fin 2) >> ((1 : Fin 2) >> R)) + have h1 : + step target + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> ((1 : Fin 2) >> ((1 : Fin 2) >> R)))) = + some (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) + ((1 : Fin 2) >> ((1 : Fin 2) >> R))) := by + mstep + have h2 : + step target + (Cfg.headRight E (([1] : List (Fin 2)) ^ (2 * c + 2) +> default) + ((1 : Fin 2) >> ((1 : Fin 2) >> R))) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + have hF' : + ReachesPlus target + (Cfg.headRight A default + (([1, 0] : List (Fin 2)) ^ c +> + ((1 : Fin 2) >> ((1 : Fin 2) >> ((1 : Fin 2) >> R))))) + (Cfg.headRight F (([1] : List (Fin 2)) ^ (2 * c + 1) +> default) + ((1 : Fin 2) >> ((1 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + simpa only [R, list_pow_succ, List.singleton_append, ListBlank.append_cons] using hF + simpa only [R, list_pow_succ, list_pow_zero, List.cons_append, List.nil_append, + ListBlank.append_cons, ListBlank.append_nil] using + hF'.trans_star (ReachesStar.head h1 (ReachesStar.single h2)) + +private theorem step_A1_preamble (c d : ℕ) : + ReachesPlus target (encode (.A 1 c d)) + (Cfg.headRight A (([1] : List (Fin 2)) ^ 2 +> default) + (([0, 1] : List (Fin 2)) ^ (c + 1) +> (([1] : List (Fin 2)) ^ d +> default))) := by + simp only [encode] + rw [pow10_append_one] + set R := ([0, 1] : List (Fin 2)) ^ c +> (([1] : List (Fin 2)) ^ d +> default) + have h01 : + ([0, 1] : List (Fin 2)) ^ (c + 1) +> (([1] : List (Fin 2)) ^ d +> default) = + (0 : Fin 2) >> ((1 : Fin 2) >> R) := by + simp only [R, list_pow_succ, List.cons_append, List.nil_append, ListBlank.append_cons] + rw [h01] + have h1 : + step target (Cfg.headRight A (([1] : List (Fin 2)) ^ 1 +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headLeft E (([1] : List (Fin 2)) ^ 1 +> default) ((1 : Fin 2) >> R)) := by + mstep + have h2 : + step target (Cfg.headLeft E (([1] : List (Fin 2)) ^ 1 +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headLeft A default ((0 : Fin 2) >> ((1 : Fin 2) >> R))) := by + mstep + have h3 : + step target (Cfg.headLeft A default ((0 : Fin 2) >> ((1 : Fin 2) >> R))) = + some (Cfg.headRight B (([1] : List (Fin 2)) ^ 1 +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) := by + mstep + have h4 : + step target + (Cfg.headRight B (([1] : List (Fin 2)) ^ 1 +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) = + some (Cfg.headLeft C (([1] : List (Fin 2)) ^ 1 +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) := by + mstep + have h5 : + step target + (Cfg.headLeft C (([1] : List (Fin 2)) ^ 1 +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) = + some (Cfg.headLeft C default + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + have h6 : + step target (Cfg.headLeft C default ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) = + some (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) := by + mstep + have h7 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + ((1 : Fin 2) >> ((0 : Fin 2) >> ((1 : Fin 2) >> R)))) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ 2 +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) := by + mstep + exact ReachesPlus.head h1 (ReachesStar.head h2 (ReachesStar.head h3 + (ReachesStar.head h4 (ReachesStar.head h5 (ReachesStar.head h6 (ReachesStar.single h7)))))) + +private theorem end_odd_0 (n : ℕ) : + ReachesPlus target + (Cfg.headRight A (([1] : List (Fin 2)) ^ (n + 1) +> default) default) + (encode (.A 2 0 n)) := by + have h1 : + step target (Cfg.headRight A (([1] : List (Fin 2)) ^ (n + 1) +> default) default) = + some (Cfg.headRight B (([1] : List (Fin 2)) ^ (n + 2) +> default) default) := by + mstep + have h2 : + step target (Cfg.headRight B (([1] : List (Fin 2)) ^ (n + 2) +> default) default) = + some (Cfg.headLeft C (([1] : List (Fin 2)) ^ (n + 2) +> default) default) := by + mstep + have hC := sweep_C_left (n + 2) default (default : ListBlank (Fin 2)) + have h3 : + step target (Cfg.headLeft C default (([1] : List (Fin 2)) ^ (n + 2) +> default)) = + some (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([1] : List (Fin 2)) ^ (n + 2) +> default)) := by + mstep + have h4 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([1] : List (Fin 2)) ^ (n + 2) +> default)) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ 2 +> default) + ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ n +> default))) := by + simp only [list_pow_succ, List.singleton_append, ListBlank.append_cons] + mstep + exact ReachesPlus.head h1 (ReachesStar.head h2 (hC.trans + (ReachesStar.head h3 (ReachesStar.single h4)))) + +private theorem end_even_tail_to_D (m : ℕ) (R : ListBlank (Fin 2)) : + ReachesPlus target + (Cfg.headRight A (([1] : List (Fin 2)) ^ m +> default) ((0 : Fin 2) >> ((1 : Fin 2) >> R))) + (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([0] : List (Fin 2)) ^ (m + 3) +> R)) := by + have h1 : + step target + (Cfg.headRight A (([1] : List (Fin 2)) ^ m +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> R))) = + some (Cfg.headRight B (([1] : List (Fin 2)) ^ (m + 1) +> default) ((1 : Fin 2) >> R)) := by + mstep + have h2 : + step target + (Cfg.headRight B (([1] : List (Fin 2)) ^ (m + 1) +> default) ((1 : Fin 2) >> R)) = + some (Cfg.headLeft B (([1] : List (Fin 2)) ^ (m + 1) +> default) ((0 : Fin 2) >> R)) := by + mstep + have hB := sweep_B_left (m + 1) default ((0 : Fin 2) >> R) + have hB' : + ReachesStar target + (Cfg.headLeft B (([1] : List (Fin 2)) ^ (m + 1) +> default) ((0 : Fin 2) >> R)) + (Cfg.headLeft B default (([0] : List (Fin 2)) ^ (m + 2) +> R)) := by + simpa only [append_sym_pow] using hB + have h3 : + step target (Cfg.headLeft B default (([0] : List (Fin 2)) ^ (m + 2) +> R)) = + some (Cfg.headLeft C default (([0] : List (Fin 2)) ^ (m + 3) +> R)) := by + mstep + have h4 : + step target (Cfg.headLeft C default (([0] : List (Fin 2)) ^ (m + 3) +> R)) = + some (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([0] : List (Fin 2)) ^ (m + 3) +> R)) := by + mstep + exact ReachesPlus.head h1 (ReachesStar.head h2 + (hB'.trans (ReachesStar.head h3 (ReachesStar.single h4)))) + +private theorem step_A1_even_0 (k : ℕ) : + ReachesPlus target (encode (.A 1 (2 * k) 0)) (encode (.Run 1)) := by + have hpre := step_A1_preamble (2 * k) 0 + rw [list_pow_zero, ListBlank.append_nil, pow01_split_even] at hpre + have hloop := loop_0101 k 2 ((0 : Fin 2) >> ((1 : Fin 2) >> default)) + have hend := end_even_tail_to_D (2 + 6 * k) default + rw [pow_zeros_append_default] at hend + exact (hpre.trans_star hloop).trans hend -variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] +private theorem step_A1_odd_0 (k : ℕ) : + ReachesPlus target (encode (.A 1 (2 * k + 1) 0)) (encode (.A 2 0 (6 * k + 7))) := by + have hpre := step_A1_preamble (2 * k + 1) 0 + rw [list_pow_zero, ListBlank.append_nil, show 2 * k + 1 + 1 = 2 * k + 2 from rfl, + pow01_split_odd] at hpre + have hloop := loop_0101 (k + 1) 2 (default : ListBlank (Fin 2)) + have hend := end_odd_0 (6 * k + 7) + rw [show 2 + 6 * (k + 1) = 6 * k + 7 + 1 from by omega] at hloop + exact (hpre.trans_star hloop).trans hend -/-- Transition function for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 1 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.left) - | 1, 1 => some (some 1, Stmt.write 0 Dir.left) - | 2, 0 => some (some 3, Stmt.write 1 Dir.right) - | 2, 1 => some (some 2, Stmt.write 1 Dir.left) - | 3, 0 => some (some 3, Stmt.write 1 Dir.right) - | 3, 1 => some (some 0, Stmt.write 1 Dir.right) - | 4, 0 => some (some 5, Stmt.write 1 Dir.right) - | 4, 1 => some (some 0, Stmt.write 0 Dir.left) - | 5, 0 => none - | 5, 1 => some (some 4, Stmt.write 1 Dir.right) +private theorem step_A1_even_1 (k : ℕ) : + ReachesPlus target (encode (.A 1 (2 * k) 1)) (encode (.A 2 0 (6 * k + 6))) := by + have hpre := step_A1_preamble (2 * k) 1 + rw [pow01_split_even] at hpre + have hloop := + loop_0101 k 2 ((0 : Fin 2) >> ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ 1 +> default))) + have hend := end_even_tail_to_D (2 + 6 * k) ((1 : Fin 2) >> default) + have hD := sweep_D_right (2 + 6 * k + 3) 1 default ((1 : Fin 2) >> default) + have hD1 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ (1 + (2 + 6 * k + 3)) +> default) + ((1 : Fin 2) >> default)) = + some (Cfg.headRight A (([1] : List (Fin 2)) ^ (6 * k + 7) +> default) default) := by + rw [show 1 + (2 + 6 * k + 3) = 6 * k + 6 from by omega] + mstep + have hodd := end_odd_0 (6 * k + 6) + have hpre' : + ReachesPlus target (encode (.A 1 (2 * k) 1)) + (Cfg.headRight A (([1] : List (Fin 2)) ^ (2 + 6 * k) +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> ((1 : Fin 2) >> default)))) := by + refine hpre.trans_star ?_ + simpa only [list_pow_one, List.singleton_append, ListBlank.append_cons, + ListBlank.append_nil] using hloop + exact ((hpre'.trans hend).trans_star (hD.trans (ReachesStar.single hD1))).trans hodd --- END TRUSTED DEFINITIONS +private theorem step_A1_even_d2 (k d : ℕ) : + ReachesPlus target (encode (.A 1 (2 * k) (d + 2))) (encode (.A (6 * k + 7) 0 d)) := by + have hpre := step_A1_preamble (2 * k) (d + 2) + rw [pow01_split_even] at hpre + have hloop := + loop_0101 k 2 ((0 : Fin 2) >> ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ (d + 2) +> default))) + let R := (1 : Fin 2) >> ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ d +> default)) + have hend := end_even_tail_to_D (2 + 6 * k) R + have hD := sweep_D_right (2 + 6 * k + 3) 1 default R + have hD1 : + step target + (Cfg.headRight D (([1] : List (Fin 2)) ^ (1 + (2 + 6 * k + 3)) +> default) R) = + some (encode (.A (6 * k + 7) 0 d)) := by + simp only [encode, list_pow_zero, ListBlank.append_nil, R] + rw [show 1 + (2 + 6 * k + 3) = 6 * k + 6 from by omega] + mstep + have hend' : + ReachesPlus target + (Cfg.headRight A (([1] : List (Fin 2)) ^ (2 + 6 * k) +> default) + ((0 : Fin 2) >> ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ (d + 2) +> default)))) + (Cfg.headRight D (([1] : List (Fin 2)) ^ 1 +> default) + (([0] : List (Fin 2)) ^ (2 + 6 * k + 3) +> R)) := by + simpa only [R, list_pow_succ, List.singleton_append, ListBlank.append_cons] using hend + exact (hpre.trans_star hloop).trans (hend'.trans_star (hD.trans (ReachesStar.single hD1))) +private theorem step_A1_odd_d1 (k d : ℕ) : + ReachesPlus target (encode (.A 1 (2 * k + 1) (d + 1))) (encode (.A (6 * k + 8) 0 d)) := by + have hpre := step_A1_preamble (2 * k + 1) (d + 1) + rw [show 2 * k + 1 + 1 = 2 * k + 2 from rfl, pow01_split_odd] at hpre + have hloop := loop_0101 (k + 1) 2 (([1] : List (Fin 2)) ^ (d + 1) +> default) + simpa only [encode, list_pow_zero, list_pow_succ, List.singleton_append, ListBlank.append_cons, + ListBlank.append_nil, show 2 + 6 * (k + 1) = 6 * k + 8 from by omega] using + hpre.trans_star hloop --- BEGIN EXPLORATORY DEFINITIONS AND LEMMAS +private theorem init_reaches_start : ReachesPlus target (init []) (encode start) := by + dsimp only [start, encode, list_pow_zero, list_pow_succ, List.cons_append, List.singleton_append, + List.nil_append, ListBlank.append_cons, ListBlank.append_nil] + bb_steps -namespace Solution +/-- Level B valid acceleration theorem for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem is_valid_acceleration : IsValidAcceleration target start encode next := by + refine IsValidAcceleration.of_step init_reaches_start.to_star ?_ + intro s + cases s with + | Run a => exact step_Run a + | A a c d => + rcases a with _ | _ | a + · rcases d with _ | _ | d + · obtain ⟨cfg', hplus, hnone⟩ := step_A0_c0_halt c + exact ⟨cfg', hplus.to_star, hnone⟩ + · simpa [next] using step_A0_c1 c + · simpa [next] using step_A0_cd2 c d + · rcases Nat.even_or_odd' c with ⟨k, rfl | rfl⟩ + · rcases d with _ | _ | d + · simpa [next] using step_A1_even_0 k + · simpa [next, show 3 * (2 * k) + 6 = 6 * k + 6 from by omega] using + step_A1_even_1 k + · simpa [next, show 3 * (2 * k) + 7 = 6 * k + 7 from by omega] using + step_A1_even_d2 k d + · have hmod : (2 * k + 1) % 2 ≠ 0 := by omega + rcases d with _ | d + · simpa [next, hmod, show 3 * (2 * k + 1) + 4 = 6 * k + 7 from by omega] using + step_A1_odd_0 k + · rcases d with _ | d + · simpa [next, hmod, show 3 * (2 * k + 1) + 5 = 6 * k + 8 from by omega] using + step_A1_odd_d1 k 0 + · simpa [next, hmod, show 3 * (2 * k + 1) + 5 = 6 * k + 8 from by omega] using + step_A1_odd_d1 k (d + 1) + · simpa [next] using step_A_ge2 a c d -set_option linter.unusedVariables false -set_option linter.unusedSimpArgs false -set_option linter.deprecated false -set_option linter.dupNamespace false -set_option linter.unreachableTactic false -set_option linter.unusedTactic false -set_option quotPrecheck false -set_option maxRecDepth 4000000 -set_option maxHeartbeats 8000000 +/-- Machine halting equivalence for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem isHalt_iff_acceleration : IsHalt target ↔ CollatzHalts next start := + is_valid_acceleration.isHalt_iff -variable {zG_ zL_ α β γ : Type*} [Inhabited zG_] [Inhabited zL_] -abbrev A : Fin 6 := 0 -abbrev B : Fin 6 := 1 -abbrev C : Fin 6 := 2 -abbrev D : Fin 6 := 3 -abbrev E : Fin 6 := 4 -abbrev F : Fin 6 := 5 -variable {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] -set_option linter.unusedSimpArgs false -set_option maxHeartbeats 8000000 -set_option maxRecDepth 4000000 -namespace Solution -@[simp] lemma zPz (l : List (Fin 2)) : l ^ (0 : Nat) = [] := rfl -@[simp] lemma zPsl (l : List (Fin 2)) (n : Nat) : l ^ (n + 1) = l ++ (l ^ n) := rfl -@[simp] lemma zCal (x : α) (l₁ l₂ : List α) : (x :: l₁) ++ l₂ = x :: (l₁ ++ l₂) := rfl -@[simp] lemma zLan (b : ListBlank (Fin 2)) : ([] : List (Fin 2)) +> b = b := rfl -@[simp] lemma zLac (x : Fin 2) (xs : List (Fin 2)) (b : ListBlank (Fin 2)) : (x :: xs) +> b = x >> (xs +> b) := rfl -@[simp] lemma zZcd : (0 : Fin 2) >> default = default := by - apply Turing.ListBlank.ext; intro i; cases i <;> rfl -@[simp] lemma zDh : (default : ListBlank (Fin 2)).head = 0 := rfl -@[simp] lemma zDt : (default : ListBlank (Fin 2)).tail = default := rfl -lemma zStp {c_1 c_2 : Cfg (Fin 2) (Fin 6)} (h : step target_tm c_1 = some c_2) : c_1 [target_tm]⊢⁺ c_2 := ⟨1, by decide, h⟩ -local notation "zzTP" => TapePattern (Fin 2) (Fin 6) -local notation "zzTE" => TapeExpr (Fin 2) -local notation "zzG" => Cfg (Fin 2) (Fin 6) -local notation "zzV" => Nat -> Nat -local notation "zzE" => evalTapePattern -local notation "zzD" => TapeExpr.default -local notation "zz0" x:arg => TapeExpr.sym 0 x -local notation "zz1" x:arg => TapeExpr.sym 1 x -local notation "zzR" l:arg v:arg x:arg => TapeExpr.rep l v x -local notation "zzM" l:arg q:arg r:arg => ({ left := l, head := some q, right := r } : TapePattern (Fin 2) (Fin 6)) -local notation "zzF1" a:arg => (fun k : Nat => match k with | 0 => a | _ => 0) -local notation "zzF2" a:arg b:arg => (fun k : Nat => match k with | 0 => a | 1 => b | _ => 0) -local notation "zzF3" a:arg b:arg c:arg => (fun k : Nat => match k with | 0 => a | 1 => b | 2 => c | _ => 0) -local notation "zzF4" a:arg b:arg c:arg d:arg => (fun k : Nat => match k with | 0 => a | 1 => b | 2 => c | 3 => d | _ => 0) -local macro "zzS1" : tactic => `(tactic| simp only [step, target_tm, evalTapePattern, evalTapeExpr, zPz, zPsl, zCal, List.singleton_append, List.nil_append, Turing.Tape.write, Turing.Tape.move, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt, Option.map]) -local macro "zzS2" : tactic => `(tactic| simp only [zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt]) -local macro "zzD1" a:ident b:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; zzS1)) -local macro "zzD2" a:ident b:ident c:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; rw [$c:ident]; zzS1)) -local macro "zzD3" a:ident b:ident c:ident : tactic => `(tactic| (rw [$c:ident]; simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; zzS1)) -local macro "zzD4" a:ident b:ident c:ident d:ident : tactic => `(tactic| (rw [$c:ident]; simp -failIfUnchanged only [evalTapePattern, $a:ident, $b:ident, evalTapeExpr]; rw [$d:ident]; zzS1)) -local macro "zzD5" a:ident : tactic => `(tactic| (simp -failIfUnchanged only [evalTapePattern, $a:ident, evalTapeExpr]; zzS1)) -local macro "zzH" v:ident h:ident e:term : tactic => `(tactic| obtain ⟨$v:ident, $h:ident⟩ : ∃ $v:ident : zzV, $v:ident = $e := ⟨_, rfl⟩) -@[simp] abbrev zP0 := (zzM (zz1 (zz1 zzD)) 0 zzD) -@[simp] def zK1 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 zzD) zv -@[simp] def zK2 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 2 (zz1 zzD)) zv -@[simp] def zK3 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 zzD))) zv -@[simp] def zK4 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK5 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zz1 zzD))))) zv -@[simp] def zK6 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK7 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 zzD))) zv -@[simp] def zK8 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK9 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 zzD))))) zv -@[simp] def zK10 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD))))) zv -@[simp] def zK11 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz1 zzD))) zv -@[simp] def zK12 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD)))))) zv -@[simp] def zK13 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 zzD)) zv -@[simp] def zK14 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD))))) zv -@[simp] def zK15 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 zzD)) zv -@[simp] def zK16 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 zzD))) zv -@[simp] def zK17 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 zzD)))))) zv -@[simp] def zK18 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 zzD))) zv -@[simp] def zK19 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 zzD)) zv -@[simp] def zK20 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 (zz1 zzD))))) zv -@[simp] def zK21 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 zzD)))) zv -@[simp] def zK22 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 zzD)) zv -@[simp] def zK23 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 zzD))) zv -@[simp] def zK24 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 zzD)))))) zv -@[simp] def zK25 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 zzD))) zv -@[simp] def zK26 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 zzD))) zv -@[simp] def zK27 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK28 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK29 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] abbrev zP30 := (zzM zzD 2 (zz0 (zz1 (zzR [0,1] 0 zzD)))) -@[simp] def zK31 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv -@[simp] def zK32 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv -@[simp] def zK33 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 zzD)) zv -@[simp] def zK34 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK35 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK36 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK37 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK38 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv -@[simp] def zK39 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv -@[simp] def zK40 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv -@[simp] def zK41 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv -@[simp] def zK42 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 zzD)) zv -@[simp] def zK43 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK44 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK45 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 zzD)) zv -@[simp] def zK46 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv -@[simp] def zK47 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 zzD)) zv -@[simp] def zK48 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))))) zv -@[simp] def zK49 (zv : zzV) := zzE (zzM zzD 1 (zz1 zzD)) zv -@[simp] def zK50 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD)))))))) zv -@[simp] def zK51 (zv : zzV) := zzE (zzM zzD 1 zzD) zv -@[simp] def zK52 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv -@[simp] def zK53 (zv : zzV) := zzE (zzM zzD 2 zzD) zv -@[simp] def zK54 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv -@[simp] def zK55 (zv : zzV) := zzE (zzM (zz1 zzD) 3 zzD) zv -@[simp] def zK56 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK57 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv -@[simp] def zK58 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 zzD) zv -@[simp] def zK59 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv -@[simp] def zK60 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv -@[simp] def zK61 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 zzD) zv -@[simp] def zK62 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 zzD)) zv -@[simp] def zK63 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK64 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK65 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv -@[simp] abbrev zP66 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 zzD) -@[simp] def zK67 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 zzD) zv -@[simp] abbrev zP68 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))) -@[simp] def zK69 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zzR [0,1] 1 zzD)))) zv -@[simp] def zK70 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD))))))) zv -@[simp] def zK71 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 zzD) zv -@[simp] def zK72 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 zzD) zv -@[simp] def zK73 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 zzD)) zv -@[simp] def zK74 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK75 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 zzD)) zv -@[simp] def zK76 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK77 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK78 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD)))))))) zv -@[simp] def zK79 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 zzD)) zv -@[simp] def zK80 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 zzD)) zv -@[simp] def zK81 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv -@[simp] def zK82 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 zzD))) zv -@[simp] def zK83 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))) zv -@[simp] def zK84 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK85 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv -@[simp] def zK86 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK87 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK88 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD)))))))) zv -@[simp] def zK89 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD)))))))) zv -@[simp] def zK90 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK91 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK92 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 zzD))))))))) zv -@[simp] def zK93 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 zzD))))))))) zv -@[simp] def zK94 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK95 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK96 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK97 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK98 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK99 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK100 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK101 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK102 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK103 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK104 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK105 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv -@[simp] def zK106 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK107 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK108 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] def zK109 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK110 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK111 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK112 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK113 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK114 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK115 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK116 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK117 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK118 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK119 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK120 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK121 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK122 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK123 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK124 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK125 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK126 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv -@[simp] def zK127 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 zzD))))) zv -@[simp] def zK128 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] def zK129 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] def zK130 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))))) zv -@[simp] def zK131 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 zzD)))))) zv -@[simp] def zK132 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))))) zv -@[simp] def zK133 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK134 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK135 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv -@[simp] def zK136 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK137 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK138 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK139 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))) zv -@[simp] abbrev zP140 := (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) -@[simp] def zK141 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK142 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK143 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 zzD))) zv -@[simp] def zK144 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv -@[simp] def zK145 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK146 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK147 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK148 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK149 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 zzD)) zv -@[simp] def zK150 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))) zv -@[simp] def zK151 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK152 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK153 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK154 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK155 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK156 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK157 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 zzD) zv -@[simp] def zK158 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 zzD))) zv -@[simp] def zK159 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv -@[simp] def zK160 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK161 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK162 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK163 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK164 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK165 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK166 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK167 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 zzD) zv -@[simp] def zK168 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 zzD)) zv -@[simp] def zK169 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD))))) zv -@[simp] def zK170 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK171 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK172 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK173 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 zzD)) zv -@[simp] def zK174 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK175 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK176 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK177 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK178 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK179 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK180 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv -@[simp] def zK181 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 zzD)) zv -@[simp] def zK182 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 zzD)) zv -@[simp] def zK183 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 zzD) zv -@[simp] def zK184 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 zzD))) zv -@[simp] def zK185 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD)))))) zv -@[simp] def zK186 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK187 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv -@[simp] def zK188 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK189 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 zzD))) zv -@[simp] def zK190 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 zzD))) zv -@[simp] def zK191 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK192 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK193 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK194 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK195 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK196 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK197 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK198 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))) zv -@[simp] def zK199 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 zzD))) zv -@[simp] def zK200 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 zzD))) zv -@[simp] def zK201 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK202 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK203 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK204 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK205 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 zzD)))) zv -@[simp] def zK206 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK207 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] abbrev zP208 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) -@[simp] def zK209 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 zzD)))) zv -@[simp] def zK210 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK211 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zz1 zzD)))) zv -@[simp] def zK212 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv -@[simp] def zK213 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv -@[simp] def zK214 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 zzD))))) zv -@[simp] def zK215 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK216 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] def zK217 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK218 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 zzD))))) zv -@[simp] def zK219 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK220 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK221 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK222 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 zzD))) zv -@[simp] def zK223 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK224 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 2 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK225 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 zzD)) zv -@[simp] def zK226 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK227 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK228 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK229 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK230 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK231 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK232 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK233 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 zzD)))))) zv -@[simp] def zK234 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK235 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK236 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv -@[simp] def zK237 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 zzD)) zv -@[simp] def zK238 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK239 (zv : zzV) := zzE (zzM (zz1 zzD) 2 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK240 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 2 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK241 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 zzD) zv -@[simp] def zK242 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 zzD)))) zv -@[simp] def zK243 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD)))))) zv -@[simp] def zK244 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD)))))) zv -@[simp] abbrev zP245 := (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 (zzR [1,1] 0 zzD)))) -@[simp] def zK246 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK247 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK248 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK249 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD)))))) zv -@[simp] def zK250 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD)))))) zv -@[simp] def zK251 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK252 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK253 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK254 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK255 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))))) zv -@[simp] def zK256 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz0 (zzR [1,0] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))))) zv -@[simp] def zK257 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK258 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 zzD)) zv -@[simp] def zK259 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 zzD))))) zv -@[simp] def zK260 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK261 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK262 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK263 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 zzD))))))) zv -@[simp] def zK264 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 zzD))))))) zv -@[simp] def zK265 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv -@[simp] def zK266 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK267 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK268 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 zzD) zv -@[simp] def zK269 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 zzD)))) zv -@[simp] def zK270 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] abbrev zP271 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zzR [1,1] 1 zzD)))) -@[simp] def zK272 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK273 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 zzD)) zv -@[simp] def zK274 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 zzD))))) zv -@[simp] def zK275 (zv : zzV) := zzE (zzM zzD 0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK276 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK277 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK278 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK279 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK280 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK281 (zv : zzV) := zzE (zzM zzD 2 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK282 (zv : zzV) := zzE (zzM (zz1 zzD) 0 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK283 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK284 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK285 (zv : zzV) := zzE (zzM zzD 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK286 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK287 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK288 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK289 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK290 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK291 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))) zv -@[simp] def zK292 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK293 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK294 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))))) zv -@[simp] def zK295 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD)))))))) zv -@[simp] def zK296 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))))) zv -@[simp] def zK297 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK298 (zv : zzV) := zzE (zzM zzD 1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK299 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK300 (zv : zzV) := zzE (zzM zzD 2 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK301 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK302 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK303 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK304 (zv : zzV) := zzE (zzM (zz1 zzD) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK305 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz1 (zz1 (zzR [1,1] 0 zzD)))) zv -@[simp] def zK306 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK307 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK308 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 3 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK309 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 zzD)) zv -@[simp] def zK310 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK311 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK312 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK313 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD))))) zv -@[simp] def zK314 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK315 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK316 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK317 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz1 (zz1 zzD))) zv -@[simp] def zK318 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK319 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK320 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] abbrev zP321 := (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) -@[simp] def zK322 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK323 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 3 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))) zv -@[simp] def zK324 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK325 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK326 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK327 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK328 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK329 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK330 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK331 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz1 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK332 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK333 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 3 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv -@[simp] def zK334 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv -@[simp] def zK335 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))) zv -@[simp] def zK336 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK337 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 0 zzD))))))) zv -@[simp] def zK338 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK339 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK340 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))) zv -@[simp] def zK341 (zv : zzV) := zzE (zzM zzD 0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK342 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] def zK343 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK344 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK345 (zv : zzV) := zzE (zzM zzD 4 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK346 (zv : zzV) := zzE (zzM (zz1 zzD) 4 (zz1 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK347 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 4 (zz1 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK348 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK349 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK350 (zv : zzV) := zzE (zzM (zz1 zzD) 1 (zz1 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))))) zv -@[simp] def zK351 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 1 (zz1 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD))))))))))) zv -@[simp] def zK352 (zv : zzV) := zzE (zzM (zz1 zzD) 5 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK353 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))))) zv -@[simp] def zK354 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))))) zv -@[simp] def zK355 (zv : zzV) := zzE (zzM zzD 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 0 (zz0 (zz1 (zzR [0,1] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))))))) zv -@[simp] def zK356 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 1 (zz1 (zz0 (zz0 (zz0 (zzR [0,0] 1 (zz0 (zz1 (zzR [0,1] 2 (zz1 (zz1 (zzR [1,1] 3 zzD)))))))))))) zv -@[simp] def zK357 (zv : zzV) := zzE (zzM (zz1 (zz1 zzD)) 4 (zz0 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD)))))))) zv -@[simp] def zK358 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 zzD))) 5 (zz1 (zz0 (zzR [1,0] 0 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) zv -@[simp] def zK359 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zz1 (zzR [1,1] 1 zzD))))) zv -@[simp] def zK360 (zv : zzV) := zzE (zzM (zz1 (zz1 (zzR [1,1] 0 zzD))) 4 (zz0 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD)))))))) zv -@[simp] def zK361 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz1 (zzR [1,1] 1 zzD)))) zv -@[simp] def zK362 (zv : zzV) := zzE (zzM (zz1 (zz1 (zz1 (zzR [1,1] 0 zzD)))) 5 (zz1 (zz0 (zzR [1,0] 1 (zz1 (zz1 (zzR [1,1] 2 zzD))))))) zv -@[simp] abbrev p_271_step1 := (zzM (zz1 (zzR [1,1] 0 zzD)) 0 (zz1 (zz0 (zz1 (zzR [1,1] 1 zzD))))) -@[simp] abbrev pat_30_step1 := (zzM (zz1 zzD) 3 (zz1 (zzR [0,1] 0 zzD))) -@[simp] abbrev pat_140_step1 := (zzM (zz1 zzD) 3 (zz0 (zzR [0,0] 0 (zz1 (zz1 (zz1 (zzR [1,1] 1 zzD))))))) -@[simp] abbrev pat_A3 := (zzM (zz1 (zzR [1] 0 (zzR [1,1] 1 zzD))) 3 (zzR [0] 2 (zzR [0,0] 3 (zzR [1] 4 (zzR [0,1] 5 (zzR [1,1] 6 zzD)))))) -def zC30 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 1 1)) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.not (.ge_const 6 1))))))) -def zC140 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 1 1)) (.and (.and (.ge_const 2 1) (.not (.ge_const 2 2))) (.and (.and (.ge_const 4 3) (.not (.ge_const 4 4))) (.not (.ge_const 5 1)))))) -def zC66 : VarCond := (.and (.and (.ge_const 0 1) (.not (.ge_const 0 2))) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.not (.ge_const 4 1)) (.and (.not (.ge_const 5 1)) (.not (.ge_const 6 1))))))) -def zC76 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.ge_const 1 1) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.and (.ge_const 5 1) (.not (.ge_const 6 1)))))))) -def zC331 : VarCond := (.and (.not (.ge_const 0 1)) (.and (.not (.ge_const 2 1)) (.and (.not (.ge_const 3 1)) (.and (.and (.ge_const 4 1) (.not (.ge_const 4 2))) (.and (.ge_const 5 1) (.ge_const 6 1)))))) -def cond_A3 : VarCond := (.or zC30 (.or zC140 (.or zC66 (.or zC76 zC331)))) -def ps : TapePatternSet (Fin 2) (Fin 6) := (pat_A3, cond_A3) :: [] -lemma mem_ps_A3 : (pat_A3, cond_A3) ∈ ps := .head _ -lemma in_ps_30_step1 (zv : zzV) : IsInPatternSet ps (zzE pat_30_step1 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 | 6 => 0 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [pat_30_step1, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC30 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC30, evalVarCond]; try omega - exact Or.inl h_c -lemma in_ps_140_step1 (zv : zzV) : IsInPatternSet ps (zzE pat_140_step1 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 1 | 3 => zv 0 | 4 => 3 | 5 => 0 | 6 => zv 1 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [pat_140_step1, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC140 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 1 | 3 => zv 0 | 4 => 3 | 5 => 0 | 6 => zv 1 | _ => 0) := by simp -failIfUnchanged [zC140, evalVarCond]; try omega - exact Or.inr (Or.inl h_c) -lemma zI66 (zv : zzV) : IsInPatternSet ps (zzE zP66 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 1 | 1 => zv 0 | 2 => 0 | 3 => 0 | 4 => 0 | 5 => 0 | 6 => 0 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zP66, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC66 (fun k => match k with | 0 => 1 | 1 => zv 0 | 2 => 0 | 3 => 0 | 4 => 0 | 5 => 0 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC66, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inl h_c)) -lemma zI63 (zv : zzV) : IsInPatternSet ps (zK63 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => 0 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zK63, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC76 (fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC76, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inr (Or.inl h_c))) -lemma zI76 (zv : zzV) : IsInPatternSet ps (zK76 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => 0 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zK76, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC76 (fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => 0 | _ => 0) := by simp -failIfUnchanged [zC76, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inr (Or.inl h_c))) -lemma zI287 (zv : zzV) : IsInPatternSet ps (zK287 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zK287, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => 0 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) -lemma zI314 (zv : zzV) : IsInPatternSet ps (zK314 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zK314, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 0 + 1 | 6 => zv 1 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) -lemma zI331 (zv : zzV) : IsInPatternSet ps (zK331 zv) := by - refine ⟨(pat_A3, cond_A3), mem_ps_A3, fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => zv 2 + 1 | _ => 0, ?_, ?_⟩ - · simp -failIfUnchanged only [zK331, pat_A3, evalTapePattern, evalTapeExpr] - zzS2 - · have h_c : evalVarCond zC331 (fun k => match k with | 0 => 0 | 1 => zv 0 + 1 | 2 => 0 | 3 => 0 | 4 => 1 | 5 => zv 1 + 1 | 6 => zv 2 + 1 | _ => 0) := by simp -failIfUnchanged [zC331, evalVarCond]; try omega - exact Or.inr (Or.inr (Or.inr (Or.inr h_c))) -lemma init_reaches_pat_30_step1 : (init []) [target_tm]⊢* (zzE pat_30_step1 (fun _ => 0)) := by - use 4 - have h_raw : multiStep target_tm (init []) 4 = some (⟨some 3, ⟨1, (1 : Fin 2) >> default, (0 : Fin 2) >> default⟩⟩ : Cfg (Fin 2) (Fin 6)) := rfl - rw [h_raw] - simp only [pat_30_step1, evalTapePattern, evalTapeExpr, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] -@[simp] lemma zMz (M : Machine zG_ zL_) (config : Cfg zG_ zL_) : multiStep M config 0 = some config := rfl -@[simp] lemma zMo (M : Machine zG_ zL_) (config : Cfg zG_ zL_) : multiStep M config 1 = step M config := rfl -@[simp] lemma zMs (M : Machine zG_ zL_) (config : Cfg zG_ zL_) (n : Nat) : - multiStep M config (n + 1) = Option.bind (multiStep M config n) (step M) := by - rw [multiStep, Function.iterate_succ', Function.comp_apply, multiStep] -lemma zMa {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] - (tm : Machine zG_ zL_) (c_1 : Cfg zG_ zL_) (n m : Nat) : - multiStep tm c_1 (n + m) = (multiStep tm c_1 n).bind (fun c_2 => multiStep tm c_2 m) := by - induction m with - | zero => simp - | succ m' ih => - rw [Nat.add_succ, zMs, ih, Option.bind_assoc] - simp_rw [zMs] -lemma zMt {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] - (tm : Machine zG_ zL_) (c_1 c_2 c_3 : Cfg zG_ zL_) (n m : Nat) - (h₁ : c_1 [tm]⊢^{n} c_2) (h₂ : c_2 [tm]⊢^{m} c_3) : - c_1 [tm]⊢^{n+m} c_3 := by - rw [zMa, h₁]; simp [h₂] -lemma zPt {zG_ zL_ : Type*} [Inhabited zG_] [Inhabited zL_] - {tm : Machine zG_ zL_} {c_1 c_2 c_3 : Cfg zG_ zL_} - (h₁ : c_1 [tm]⊢⁺ c_2) (h₂ : c_2 [tm]⊢⁺ c_3) : c_1 [tm]⊢⁺ c_3 := by - obtain ⟨n, n_pos, hn⟩ := h₁ - obtain ⟨m, _, hm⟩ := h₂ - exact ⟨n + m, lt_of_lt_of_le n_pos (Nat.le_add_right n m), zMt tm c_1 c_2 c_3 n m hn hm⟩ -local notation "zzQ" c:arg => ∃ cfg', (c [target_tm]⊢⁺ cfg') /\ (IsInPatternSet ps cfg' \/ (step target_tm cfg').isNone) -lemma zzB {c_1 c_2 : Cfg (Fin 2) (Fin 6)} - (h_step : step target_tm c_1 = some c_2) - (h_in : IsInPatternSet ps c_2) : - zzQ (c_1) := - ⟨c_2, zStp h_step, Or.inl h_in⟩ -lemma zzC {c_1 c_2 : Cfg (Fin 2) (Fin 6)} - (h_step : step target_tm c_1 = some c_2) - (h_next : zzQ (c_2)) : - zzQ (c_1) := by - rcases h_next with ⟨cfg', h₂, h_in⟩ - exact ⟨cfg', zPt (zStp h_step) h₂, h_in⟩ -local macro "zzR1" p1:ident p2:ident v:ident h:ident : tactic => `(tactic| refine @zzC _ (zzE $p2:ident $v:ident) (by zzD3 $p1:ident $p2:ident $h:ident) ?_) -local macro "zzR2" p1:ident p2:ident v:ident h:ident hr:ident : tactic => `(tactic| refine @zzC _ (zzE $p2:ident $v:ident) (by zzD4 $p1:ident $p2:ident $h:ident $hr:ident) ?_) -local macro "zzO" v:ident h:ident e:term p1:ident p2:ident : tactic => `(tactic| (zzH $v:ident $h:ident $e; zzR1 $p1:ident $p2:ident $v:ident $h:ident)) -local macro "zzO2" v:ident h:ident e:term p1:ident p2:ident hr:ident : tactic => `(tactic| (zzH $v:ident $h:ident $e; zzR2 $p1:ident $p2:ident $v:ident $h:ident $hr:ident)) -local macro "zzK1" c1:ident c2:ident e:term : tactic => `(tactic| (refine zzC ?_ $e; zzD1 $c1:ident $c2:ident)) -local macro "zzK2" c1:ident c2:ident h:ident e:term : tactic => `(tactic| (refine zzC ?_ $e; zzD2 $c1:ident $c2:ident $h:ident)) -local macro "zzKB1" c1:ident c2:ident e:term : tactic => `(tactic| (refine zzB ?_ $e; zzD1 $c1:ident $c2:ident)) -local macro "zzKB2" c1:ident c2:ident h:ident e:term : tactic => `(tactic| (refine zzB ?_ $e; zzD2 $c1:ident $c2:ident $h:ident)) -lemma step_to_ps_30 (zv : zzV) : zzQ ((zzE zP30 zv)) := by zzKB1 zP30 pat_30_step1 (in_ps_30_step1 zv) -lemma step_to_ps_140 (zv : zzV) : zzQ ((zzE zP140 zv)) := by zzKB1 zP140 pat_140_step1 (in_ps_140_step1 zv) -lemma zS27 (zv : zzV) : zzQ ((zK27 zv)) := by zzK1 zK27 zP30 (step_to_ps_30 (zzF1 (1))) -lemma zS25 (zv : zzV) : zzQ ((zK25 zv)) := by zzK1 zK25 zK27 (zS27 (fun _ => 0)) -lemma zS21 (zv : zzV) : zzQ ((zK21 zv)) := by zzK1 zK21 zK25 (zS25 (fun _ => 0)) -lemma zS18 (zv : zzV) : zzQ ((zK18 zv)) := by zzK1 zK18 zK21 (zS21 (fun _ => 0)) -lemma zS15 (zv : zzV) : zzQ ((zK15 zv)) := by zzK1 zK15 zK18 (zS18 (fun _ => 0)) -lemma zS13 (zv : zzV) : zzQ ((zK13 zv)) := by zzK1 zK13 zK15 (zS15 (fun _ => 0)) -lemma zS11 (zv : zzV) : zzQ ((zK11 zv)) := by zzK1 zK11 zK13 (zS13 (fun _ => 0)) -lemma zS44 (zv : zzV) : zzQ ((zK44 zv)) := by zzK1 zK44 zP30 (step_to_ps_30 (zzF1 ((zv 0 + 1)))) -lemma zS39 (zv : zzV) : zzQ ((zK39 zv)) := by zzK1 zK39 zK44 (zS44 (zzF1 (zv 0))) -lemma zS35 (zv : zzV) : zzQ ((zK35 zv)) := by zzK1 zK35 zK39 (zS39 (zzF1 (zv 0))) -lemma zS31 (zv : zzV) : zzQ ((zK31 zv)) := by zzK1 zK31 zK35 (zS35 (zzF1 (1))) -lemma zS28 (zv : zzV) : zzQ ((zK28 zv)) := by zzK1 zK28 zK31 (zS31 (fun _ => 0)) -lemma zS40 (zv : zzV) : zzQ ((zK40 zv)) := by zzK1 zK40 zK35 (zS35 (zzF1 ((zv 0 + 1)))) -lemma zS36 (zv : zzV) : zzQ ((zK36 zv)) := by zzK1 zK36 zK40 (zS40 (zzF1 (zv 0))) -lemma zA41 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK37 zv'))) : - zzQ ((zK41 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK41 zK36 h_vl (zS36 (zzF1 ((zv 1 + 1)))) - · zzK2 zK41 zK37 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) -lemma zS37 (zv : zzV) : zzQ ((zK37 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK37 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK37 zK41 (zA41 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS32 (zv : zzV) : zzQ ((zK32 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK32 zK36 h_vl (zS36 (zzF1 (1))) - · zzK2 zK32 zK37 h_vl (zS37 (zzF2 (l) (1))) -lemma zS29 (zv : zzV) : zzQ ((zK29 zv)) := by zzK1 zK29 zK32 (zS32 (zzF1 (zv 0))) -lemma step_cfg_284_succ (zv : zzV) : zzQ ((zK284 (zzF2 ((zv 0 + 1)) (zv 1)))) := by zzKB1 zK284 zK287 (zI287 (zzF2 (zv 0) (zv 1))) -lemma zS281 (zv : zzV) : zzQ ((zK281 zv)) := by zzK1 zK281 zK284 (step_cfg_284_succ zv) -lemma zS279 (zv : zzV) : zzQ ((zK279 zv)) := by zzK1 zK279 zK281 (zS281 (zzF2 (zv 0) (zv 1))) -lemma zS275 (zv : zzV) : zzQ ((zK275 zv)) := by zzK1 zK275 zK279 (zS279 (zzF2 (zv 0) (zv 1))) -lemma zS270 (zv : zzV) : zzQ ((zK270 zv)) := by zzK1 zK270 zK275 (zS275 (zzF2 (1) (zv 0))) -lemma zS260 (zv : zzV) : zzQ ((zK260 zv)) := by zzK1 zK260 zK270 (zS270 (zzF1 (zv 0))) -lemma zS285 (zv : zzV) : zzQ ((zK285 zv)) := by zzK1 zK285 zK275 (zS275 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS282 (zv : zzV) : zzQ ((zK282 zv)) := by zzK1 zK282 zK285 (zS285 (zzF2 (zv 0) (zv 1))) -lemma zA286 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK283 zv'))) : - zzQ ((zK286 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK286 zK282 h_vl (zS282 (zzF2 ((zv 1 + 1)) (zv 2))) - · zzK2 zK286 zK283 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS283 (zv : zzV) : zzQ ((zK283 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK283 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK283 zK286 (zA286 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS280 (zv : zzV) : zzQ ((zK280 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK280 zK282 h_vl (zS282 (zzF2 (1) (zv 1))) - · zzK2 zK280 zK283 h_vl (zS283 (zzF3 (l) (1) (zv 1))) -lemma zS276 (zv : zzV) : zzQ ((zK276 zv)) := by zzK1 zK276 zK280 (zS280 (zzF2 (zv 0) (zv 1))) -lemma step_hub_271_step1 (zv : zzV) : zzQ ((zzE p_271_step1 zv)) := by - rcases h_vr : zv 1 with _ | r - · rcases h_vl : zv 0 with _ | l - · have h_eq : zzE p_271_step1 zv = zK28 (fun _ => 0) := by - simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK28, evalTapeExpr]; rw [h_vr, h_vl] - zzS2 - rw [h_eq]; exact zS28 (fun _ => 0) - · have h_eq : zzE p_271_step1 zv = zK29 (zzF1 (l)) := by - simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK29, evalTapeExpr]; rw [h_vr, h_vl] - zzS2 - rw [h_eq]; exact zS29 (zzF1 (l)) - · rcases h_vl : zv 0 with _ | l - · have h_eq : zzE p_271_step1 zv = zK260 (zzF1 (r)) := by - simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK260, evalTapeExpr]; rw [h_vr, h_vl] - zzS2 - rw [h_eq]; exact zS260 (zzF1 (r)) - · have h_eq : zzE p_271_step1 zv = zK276 (zzF2 (l) (r)) := by - simp -failIfUnchanged only [evalTapePattern, p_271_step1, zK276, evalTapeExpr]; rw [h_vr, h_vl] - zzS2 - rw [h_eq]; exact zS276 (zzF2 (l) (r)) -lemma step_to_ps_271 (zv : zzV) : zzQ ((zzE zP271 zv)) := by zzK1 zP271 p_271_step1 (step_hub_271_step1 zv) -lemma step_to_ps_245 (zv : zzV) : zzQ ((zzE zP245 zv)) := by zzK1 zP245 p_271_step1 (step_hub_271_step1 (zzF2 (0) (zv 0))) -lemma zS26 (zv : zzV) : zzQ ((zK26 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK26 zK28 h_vl (zS28 (fun _ => 0)) - · zzK2 zK26 zK29 h_vl (zS29 (zzF1 (l))) -lemma zS22 (zv : zzV) : zzQ ((zK22 zv)) := by zzK1 zK22 zK26 (zS26 (zzF1 (zv 0))) -lemma zS19 (zv : zzV) : zzQ ((zK19 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK19 zK15 h_vl (zS15 (fun _ => 0)) - · zzK2 zK19 zK22 h_vl (zS22 (zzF1 (l))) -lemma zS16 (zv : zzV) : zzQ ((zK16 zv)) := by zzK1 zK16 zK19 (zS19 (zzF1 (1))) -lemma zS23 (zv : zzV) : zzQ ((zK23 zv)) := by zzK1 zK23 zK19 (zS19 (zzF1 ((zv 0 + 1)))) -lemma zA24 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK20 zv'))) : - zzQ ((zK24 zv)) := by - zzK1 zK24 zK20 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) -lemma zS20 (zv : zzV) : zzQ ((zK20 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK20 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK20 zK23 h_vr (zS23 (zzF1 (zv 0))) - · zzK2 zK20 zK24 h_vr (zA24 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS17 (zv : zzV) : zzQ ((zK17 zv)) := by zzK1 zK17 zK20 (zS20 (zzF2 (1) (zv 0))) -lemma zS14 (zv : zzV) : zzQ ((zK14 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK14 zK16 h_vr (zS16 (fun _ => 0)) - · zzK2 zK14 zK17 h_vr (zS17 (zzF1 (r))) -lemma zS12 (zv : zzV) : zzQ ((zK12 zv)) := by zzK1 zK12 zK14 (zS14 (zzF1 (zv 0))) -lemma zS10 (zv : zzV) : zzQ ((zK10 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK10 zK11 h_vr (zS11 (fun _ => 0)) - · zzK2 zK10 zK12 h_vr (zS12 (zzF1 (r))) -lemma zS9 (zv : zzV) : zzQ ((zK9 zv)) := by zzK1 zK9 zK10 (zS10 (zzF1 (1))) -lemma zS8 (zv : zzV) : zzQ ((zK8 zv)) := by zzK1 zK8 zK9 (zS9 (fun _ => 0)) -lemma zS7 (zv : zzV) : zzQ ((zK7 zv)) := by zzK1 zK7 zK8 (zS8 (fun _ => 0)) -lemma zS6 (zv : zzV) : zzQ ((zK6 zv)) := by zzK1 zK6 zK7 (zS7 (fun _ => 0)) -lemma zS5 (zv : zzV) : zzQ ((zK5 zv)) := by zzK1 zK5 zK6 (zS6 (fun _ => 0)) -lemma zS4 (zv : zzV) : zzQ ((zK4 zv)) := by zzK1 zK4 zK5 (zS5 (fun _ => 0)) -lemma zS3 (zv : zzV) : zzQ ((zK3 zv)) := by zzK1 zK3 zK4 (zS4 (fun _ => 0)) -lemma zS2 (zv : zzV) : zzQ ((zK2 zv)) := by zzK1 zK2 zK3 (zS3 (fun _ => 0)) -lemma zS1 (zv : zzV) : zzQ ((zK1 zv)) := by zzK1 zK1 zK2 (zS2 (fun _ => 0)) -lemma step_hub_0 (zv : zzV) : zzQ ((zzE zP0 zv)) := by zzK1 zP0 zK1 (zS1 (fun _ => 0)) -lemma zS33 (zv : zzV) : zzQ ((zK33 zv)) := by zzK1 zK33 zP0 (step_hub_0 (fun _ => 0)) -lemma zS61 (zv : zzV) : zzQ ((zK61 zv)) := by zzKB1 zK61 zP66 (zI66 (zzF1 (1))) -lemma zS58 (zv : zzV) : zzQ ((zK58 zv)) := by zzK1 zK58 zK61 (zS61 (fun _ => 0)) -lemma zS55 (zv : zzV) : zzQ ((zK55 zv)) := by zzK1 zK55 zK58 (zS58 (fun _ => 0)) -lemma zS53 (zv : zzV) : zzQ ((zK53 zv)) := by zzK1 zK53 zK55 (zS55 (fun _ => 0)) -lemma zS51 (zv : zzV) : zzQ ((zK51 zv)) := by zzK1 zK51 zK53 (zS53 (fun _ => 0)) -lemma zS49 (zv : zzV) : zzQ ((zK49 zv)) := by zzK1 zK49 zK51 (zS51 (fun _ => 0)) -lemma zS47 (zv : zzV) : zzQ ((zK47 zv)) := by zzK1 zK47 zK49 (zS49 (fun _ => 0)) -lemma zS45 (zv : zzV) : zzQ ((zK45 zv)) := by zzK1 zK45 zK47 (zS47 (fun _ => 0)) -lemma zS42 (zv : zzV) : zzQ ((zK42 zv)) := by zzK1 zK42 zK45 (zS45 (fun _ => 0)) -lemma zS241 (zv : zzV) : zzQ ((zK241 zv)) := by - refine ⟨zzE { left := (.sym 1 (.sym 1 (.sym 1 .default))), head := some 5, right := .default } (fun _ => 0), zStp ?_, Or.inr (by simp [step, target_tm, evalTapePattern, evalTapeExpr])⟩ - zzD5 zK241 -lemma zS225 (zv : zzV) : zzQ ((zK225 zv)) := by zzK1 zK225 zK241 (zS241 (fun _ => 0)) -lemma zS268 (zv : zzV) : zzQ ((zK268 zv)) := by - refine ⟨zzE { left := (.sym 1 (.sym 1 (.sym 1 (.rep [1, 1] 0 .default)))), head := some 5, right := .default } (zzF1 (zv 0)), zStp ?_, Or.inr (by simp [step, target_tm, evalTapePattern, evalTapeExpr])⟩ - zzD5 zK268 -lemma zS258 (zv : zzV) : zzQ ((zK258 zv)) := by zzK1 zK258 zK268 (zS268 (zzF1 (1))) -lemma zS273 (zv : zzV) : zzQ ((zK273 zv)) := by zzK1 zK273 zK268 (zS268 (zzF1 ((zv 0 + 1)))) -lemma zA274 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK269 zv'))) : - zzQ ((zK274 zv)) := by - zzK1 zK274 zK269 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) -lemma zS269 (zv : zzV) : zzQ ((zK269 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK269 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK269 zK273 h_vr (zS273 (zzF1 (zv 0))) - · zzK2 zK269 zK274 h_vr (zA274 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS259 (zv : zzV) : zzQ ((zK259 zv)) := by zzK1 zK259 zK269 (zS269 (zzF2 (1) (zv 0))) -lemma zS242 (zv : zzV) : zzQ ((zK242 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK242 zK258 h_vr (zS258 (fun _ => 0)) - · zzK2 zK242 zK259 h_vr (zS259 (zzF1 (r))) -lemma zS226 (zv : zzV) : zzQ ((zK226 zv)) := by zzK1 zK226 zK242 (zS242 (zzF1 (zv 0))) -lemma zS212 (zv : zzV) : zzQ ((zK212 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK212 zK225 h_vr (zS225 (fun _ => 0)) - · zzK2 zK212 zK226 h_vr (zS226 (zzF1 (r))) -lemma zS201 (zv : zzV) : zzQ ((zK201 zv)) := by zzK1 zK201 zK212 (zS212 (zzF1 (1))) -lemma zS189 (zv : zzV) : zzQ ((zK189 zv)) := by zzK1 zK189 zK201 (zS201 (fun _ => 0)) -lemma zS237 (zv : zzV) : zzQ ((zK237 zv)) := by zzK1 zK237 zK189 (zS189 (fun _ => 0)) -lemma zS222 (zv : zzV) : zzQ ((zK222 zv)) := by zzK1 zK222 zK237 (zS237 (fun _ => 0)) -lemma zS209 (zv : zzV) : zzQ ((zK209 zv)) := by zzK1 zK209 zK222 (zS222 (fun _ => 0)) -lemma zS199 (zv : zzV) : zzQ ((zK199 zv)) := by zzK1 zK199 zK209 (zS209 (fun _ => 0)) -lemma zS181 (zv : zzV) : zzQ ((zK181 zv)) := by zzK1 zK181 zK199 (zS199 (fun _ => 0)) -lemma zS229 (zv : zzV) : zzQ ((zK229 zv)) := by zzK1 zK229 zP245 (step_to_ps_245 (zzF1 (zv 0))) -lemma zS261 (zv : zzV) : zzQ ((zK261 zv)) := by zzK1 zK261 zP271 (step_to_ps_271 (zzF2 (1) (zv 0))) -lemma zS277 (zv : zzV) : zzQ ((zK277 zv)) := by zzK1 zK277 zP271 (step_to_ps_271 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA278 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK272 zv'))) : - zzQ ((zK278 zv)) := by - zzK1 zK278 zK272 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS272 (zv : zzV) : zzQ ((zK272 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK272 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK272 zK277 h_vr (zS277 (zzF2 (zv 0) (zv 2))) - · zzK2 zK272 zK278 h_vr (zA278 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS262 (zv : zzV) : zzQ ((zK262 zv)) := by zzK1 zK262 zK272 (zS272 (zzF3 (1) (zv 0) (zv 1))) -lemma zS246 (zv : zzV) : zzQ ((zK246 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK246 zK261 h_vr (zS261 (zzF1 (zv 1))) - · zzK2 zK246 zK262 h_vr (zS262 (zzF2 (r) (zv 1))) -lemma zS230 (zv : zzV) : zzQ ((zK230 zv)) := by zzK1 zK230 zK246 (zS246 (zzF2 (zv 0) (zv 1))) -lemma zS215 (zv : zzV) : zzQ ((zK215 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK215 zK229 h_vr (zS229 (zzF1 (zv 1))) - · zzK2 zK215 zK230 h_vr (zS230 (zzF2 (r) (zv 1))) -lemma zS203 (zv : zzV) : zzQ ((zK203 zv)) := by zzK1 zK203 zK215 (zS215 (zzF2 (1) (zv 0))) -lemma zS191 (zv : zzV) : zzQ ((zK191 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK191 zK201 h_vr (zS201 (fun _ => 0)) - · zzK2 zK191 zK203 h_vr (zS203 (zzF1 (r))) -lemma zS267 (zv : zzV) : zzQ ((zK267 zv)) := by zzK1 zK267 zK191 (zS191 (zzF1 ((zv 0 + 1)))) -lemma zS257 (zv : zzV) : zzQ ((zK257 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK257 zK237 h_vr (zS237 (fun _ => 0)) - · zzK2 zK257 zK267 h_vr (zS267 (zzF1 (r))) -lemma zS238 (zv : zzV) : zzQ ((zK238 zv)) := by zzK1 zK238 zK257 (zS257 (zzF1 (zv 0))) -lemma zS223 (zv : zzV) : zzQ ((zK223 zv)) := by zzK1 zK223 zK238 (zS238 (zzF1 (zv 0))) -lemma zS210 (zv : zzV) : zzQ ((zK210 zv)) := by zzK1 zK210 zK223 (zS223 (zzF1 (1))) -lemma zS239 (zv : zzV) : zzQ ((zK239 zv)) := by zzK1 zK239 zK223 (zS223 (zzF1 ((zv 0 + 1)))) -lemma zA240 (zv : zzV) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK224 zv'))) : - zzQ ((zK240 zv)) := by - zzK1 zK240 zK224 (h_u (zzF2 (zv 0) ((zv 1 + 1))) (by (try simp only []); omega)) -lemma zS224 (zv : zzV) : zzQ ((zK224 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK224 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK224 zK239 h_vl (zS239 (zzF1 (zv 1))) - · zzK2 zK224 zK240 h_vl (zA240 (zzF2 (l) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS211 (zv : zzV) : zzQ ((zK211 zv)) := by zzK1 zK211 zK224 (zS224 (zzF2 (zv 0) (1))) -lemma zS200 (zv : zzV) : zzQ ((zK200 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK200 zK210 h_vl (zS210 (fun _ => 0)) - · zzK2 zK200 zK211 h_vl (zS211 (zzF1 (l))) -lemma zS182 (zv : zzV) : zzQ ((zK182 zv)) := by zzK1 zK182 zK200 (zS200 (zzF1 (zv 0))) -lemma zS167 (zv : zzV) : zzQ ((zK167 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK167 zK181 h_vl (zS181 (fun _ => 0)) - · zzK2 zK167 zK182 h_vl (zS182 (zzF1 (l))) -lemma zS157 (zv : zzV) : zzQ ((zK157 zv)) := by zzK1 zK157 zK167 (zS167 (zzF1 (1))) -lemma zS149 (zv : zzV) : zzQ ((zK149 zv)) := by zzK1 zK149 zK157 (zS157 (fun _ => 0)) -lemma zS143 (zv : zzV) : zzQ ((zK143 zv)) := by zzK1 zK143 zK149 (zS149 (fun _ => 0)) -lemma zS183 (zv : zzV) : zzQ ((zK183 zv)) := by zzK1 zK183 zK167 (zS167 (zzF1 ((zv 0 + 1)))) -lemma zS168 (zv : zzV) : zzQ ((zK168 zv)) := by zzK1 zK168 zK183 (zS183 (zzF1 (zv 0))) -lemma zS158 (zv : zzV) : zzQ ((zK158 zv)) := by zzK1 zK158 zK168 (zS168 (zzF1 (1))) -lemma zS184 (zv : zzV) : zzQ ((zK184 zv)) := by zzK1 zK184 zK168 (zS168 (zzF1 ((zv 0 + 1)))) -lemma zA185 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK169 zv'))) : - zzQ ((zK185 zv)) := by - zzK1 zK185 zK169 (h_u (zzF2 ((zv 0 + 1)) (zv 1)) (by (try simp only []); omega)) -lemma zS169 (zv : zzV) : zzQ ((zK169 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK169 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK169 zK184 h_vr (zS184 (zzF1 (zv 0))) - · zzK2 zK169 zK185 h_vr (zA185 (zzF2 (zv 0) (r)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS159 (zv : zzV) : zzQ ((zK159 zv)) := by zzK1 zK159 zK169 (zS169 (zzF2 (1) (zv 0))) -lemma zS150 (zv : zzV) : zzQ ((zK150 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK150 zK158 h_vr (zS158 (fun _ => 0)) - · zzK2 zK150 zK159 h_vr (zS159 (zzF1 (r))) -lemma zS144 (zv : zzV) : zzQ ((zK144 zv)) := by zzK1 zK144 zK150 (zS150 (zzF1 (zv 0))) -lemma zS139 (zv : zzV) : zzQ ((zK139 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK139 zK143 h_vr (zS143 (fun _ => 0)) - · zzK2 zK139 zK144 h_vr (zS144 (zzF1 (r))) -lemma zS135 (zv : zzV) : zzQ ((zK135 zv)) := by zzK1 zK135 zK139 (zS139 (zzF1 ((zv 0 + 1)))) -lemma zS131 (zv : zzV) : zzQ ((zK131 zv)) := by zzK1 zK131 zK135 (zS135 (zzF1 (1))) -lemma zS127 (zv : zzV) : zzQ ((zK127 zv)) := by zzK1 zK127 zK131 (zS131 (fun _ => 0)) -lemma zS123 (zv : zzV) : zzQ ((zK123 zv)) := by zzK1 zK123 zK127 (zS127 (fun _ => 0)) -lemma zS136 (zv : zzV) : zzQ ((zK136 zv)) := by zzK1 zK136 zP140 (step_to_ps_140 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS132 (zv : zzV) : zzQ ((zK132 zv)) := by zzK1 zK132 zK136 (zS136 (zzF2 (1) (zv 0))) -lemma zS128 (zv : zzV) : zzQ ((zK128 zv)) := by zzK1 zK128 zK132 (zS132 (zzF1 (zv 0))) -lemma zS124 (zv : zzV) : zzQ ((zK124 zv)) := by zzK1 zK124 zK128 (zS128 (zzF1 (zv 0))) -lemma zS121 (zv : zzV) : zzQ ((zK121 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK121 zK123 h_vr (zS123 (fun _ => 0)) - · zzK2 zK121 zK124 h_vr (zS124 (zzF1 (r))) -lemma zS119 (zv : zzV) : zzQ ((zK119 zv)) := by zzK1 zK119 zK121 (zS121 (zzF1 (zv 0))) -lemma zS227 (zv : zzV) : zzQ ((zK227 zv)) := by zzK1 zK227 zK212 (zS212 (zzF1 ((zv 0 + 1)))) -lemma zS213 (zv : zzV) : zzQ ((zK213 zv)) := by zzK1 zK213 zK227 (zS227 (zzF1 (1))) -lemma zS243 (zv : zzV) : zzQ ((zK243 zv)) := by zzK1 zK243 zK227 (zS227 (zzF1 ((zv 0 + 1)))) -lemma zA244 (zv : zzV) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK228 zv'))) : - zzQ ((zK244 zv)) := by - zzK1 zK244 zK228 (h_u (zzF2 (zv 0) ((zv 1 + 1))) (by (try simp only []); omega)) -lemma zS228 (zv : zzV) : zzQ ((zK228 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK228 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK228 zK243 h_vl (zS243 (zzF1 (zv 1))) - · zzK2 zK228 zK244 h_vl (zA244 (zzF2 (l) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS214 (zv : zzV) : zzQ ((zK214 zv)) := by zzK1 zK214 zK228 (zS228 (zzF2 (zv 0) (1))) -lemma zS202 (zv : zzV) : zzQ ((zK202 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK202 zK213 h_vl (zS213 (fun _ => 0)) - · zzK2 zK202 zK214 h_vl (zS214 (zzF1 (l))) -lemma zS190 (zv : zzV) : zzQ ((zK190 zv)) := by zzK1 zK190 zK202 (zS202 (zzF1 (zv 0))) -lemma zS173 (zv : zzV) : zzQ ((zK173 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK173 zK189 h_vl (zS189 (fun _ => 0)) - · zzK2 zK173 zK190 h_vl (zS190 (zzF1 (l))) -lemma zS231 (zv : zzV) : zzQ ((zK231 zv)) := by zzK1 zK231 zK215 (zS215 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS216 (zv : zzV) : zzQ ((zK216 zv)) := by zzK1 zK216 zK231 (zS231 (zzF2 (1) (zv 0))) -lemma zS247 (zv : zzV) : zzQ ((zK247 zv)) := by zzK1 zK247 zK231 (zS231 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA248 (zv : zzV) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK232 zv'))) : - zzQ ((zK248 zv)) := by - zzK1 zK248 zK232 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS232 (zv : zzV) : zzQ ((zK232 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK232 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK232 zK247 h_vl (zS247 (zzF2 (zv 1) (zv 2))) - · zzK2 zK232 zK248 h_vl (zA248 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS217 (zv : zzV) : zzQ ((zK217 zv)) := by zzK1 zK217 zK232 (zS232 (zzF3 (zv 0) (1) (zv 1))) -lemma zS204 (zv : zzV) : zzQ ((zK204 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK204 zK216 h_vl (zS216 (zzF1 (zv 1))) - · zzK2 zK204 zK217 h_vl (zS217 (zzF2 (l) (zv 1))) -lemma zS192 (zv : zzV) : zzQ ((zK192 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK192 zK202 h_vr (zS202 (zzF1 (zv 0))) - · zzK2 zK192 zK204 h_vr (zS204 (zzF2 (zv 0) (r))) -lemma zS174 (zv : zzV) : zzQ ((zK174 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK174 zK191 h_vl (zS191 (zzF1 ((zv 1 + 1)))) - · zzK2 zK174 zK192 h_vl (zS192 (zzF2 (l) ((zv 1 + 1)))) -lemma zS163 (zv : zzV) : zzQ ((zK163 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK163 zK173 h_vr (zS173 (zzF1 (1))) - · zzK2 zK163 zK174 h_vr (zS174 (zzF2 (1) (r))) -lemma zS153 (zv : zzV) : zzQ ((zK153 zv)) := by zzK1 zK153 zK163 (zS163 (zzF1 (zv 0))) -lemma zS193 (zv : zzV) : zzQ ((zK193 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK193 zK173 h_vr (zS173 (zzF1 ((zv 0 + 1)))) - · zzK2 zK193 zK174 h_vr (zS174 (zzF2 ((zv 0 + 1)) (r))) -lemma zS175 (zv : zzV) : zzQ ((zK175 zv)) := by zzK1 zK175 zK193 (zS193 (zzF2 (zv 0) (zv 1))) -lemma zA194 (zv : zzV) - (h_u : ∀ zv', zv' 1 < zv 1 -> zzQ ((zK176 zv'))) : - zzQ ((zK194 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK194 zK175 h_vr (zS175 (zzF2 ((zv 0 + 1)) (zv 2))) - · zzK2 zK194 zK176 h_vr (h_u (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) -lemma zS176 (zv : zzV) : zzQ ((zK176 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK176 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK176 zK194 (zA194 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS164 (zv : zzV) : zzQ ((zK164 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK164 zK175 h_vr (zS175 (zzF2 (1) (zv 1))) - · zzK2 zK164 zK176 h_vr (zS176 (zzF3 (1) (r) (zv 1))) -lemma zS154 (zv : zzV) : zzQ ((zK154 zv)) := by zzK1 zK154 zK164 (zS164 (zzF2 (zv 0) (zv 1))) -lemma zS147 (zv : zzV) : zzQ ((zK147 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK147 zK153 h_vr (zS153 (zzF1 (zv 1))) - · zzK2 zK147 zK154 h_vr (zS154 (zzF2 (r) (zv 1))) -lemma zS141 (zv : zzV) : zzQ ((zK141 zv)) := by zzK1 zK141 zK147 (zS147 (zzF2 (zv 0) (zv 1))) -lemma zS137 (zv : zzV) : zzQ ((zK137 zv)) := by zzK1 zK137 zK141 (zS141 (zzF2 (zv 0) (zv 1))) -lemma zS133 (zv : zzV) : zzQ ((zK133 zv)) := by zzK1 zK133 zK137 (zS137 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS129 (zv : zzV) : zzQ ((zK129 zv)) := by zzK1 zK129 zK133 (zS133 (zzF2 (1) (zv 0))) -lemma zS125 (zv : zzV) : zzQ ((zK125 zv)) := by zzK1 zK125 zK129 (zS129 (zzF1 (zv 0))) -lemma zS263 (zv : zzV) : zzQ ((zK263 zv)) := by zzK1 zK263 zK135 (zS135 (zzF1 ((zv 0 + 1)))) -lemma zS249 (zv : zzV) : zzQ ((zK249 zv)) := by zzK1 zK249 zK263 (zS263 (zzF1 (zv 0))) -lemma zA264 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK250 zv'))) : - zzQ ((zK264 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK264 zK249 h_vl (zS249 (zzF1 ((zv 1 + 1)))) - · zzK2 zK264 zK250 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) -lemma zS250 (zv : zzV) : zzQ ((zK250 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK250 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK250 zK264 (zA264 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS233 (zv : zzV) : zzQ ((zK233 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK233 zK249 h_vl (zS249 (zzF1 (1))) - · zzK2 zK233 zK250 h_vl (zS250 (zzF2 (l) (1))) -lemma zS218 (zv : zzV) : zzQ ((zK218 zv)) := by zzK1 zK218 zK233 (zS233 (zzF1 (zv 0))) -lemma zS205 (zv : zzV) : zzQ ((zK205 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK205 zK127 h_vl (zS127 (fun _ => 0)) - · zzK2 zK205 zK218 h_vl (zS218 (zzF1 (l))) -lemma zS265 (zv : zzV) : zzQ ((zK265 zv)) := by zzK1 zK265 zK136 (zS136 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS251 (zv : zzV) : zzQ ((zK251 zv)) := by zzK1 zK251 zK265 (zS265 (zzF2 (zv 0) (zv 1))) -lemma zA266 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK252 zv'))) : - zzQ ((zK266 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK266 zK251 h_vl (zS251 (zzF2 ((zv 1 + 1)) (zv 2))) - · zzK2 zK266 zK252 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS252 (zv : zzV) : zzQ ((zK252 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK252 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK252 zK266 (zA266 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS234 (zv : zzV) : zzQ ((zK234 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK234 zK251 h_vl (zS251 (zzF2 (1) (zv 1))) - · zzK2 zK234 zK252 h_vl (zS252 (zzF3 (l) (1) (zv 1))) -lemma zS219 (zv : zzV) : zzQ ((zK219 zv)) := by zzK1 zK219 zK234 (zS234 (zzF2 (zv 0) (zv 1))) -lemma zS206 (zv : zzV) : zzQ ((zK206 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK206 zK128 h_vl (zS128 (zzF1 (zv 1))) - · zzK2 zK206 zK219 h_vl (zS219 (zzF2 (l) (zv 1))) -lemma zS195 (zv : zzV) : zzQ ((zK195 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK195 zK205 h_vr (zS205 (zzF1 (zv 0))) - · zzK2 zK195 zK206 h_vr (zS206 (zzF2 (zv 0) (r))) -lemma zS177 (zv : zzV) : zzQ ((zK177 zv)) := by zzK1 zK177 zK195 (zS195 (zzF2 (zv 0) (zv 1))) -lemma zS253 (zv : zzV) : zzQ ((zK253 zv)) := by zzK1 zK253 zK133 (zS133 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA254 (zv : zzV) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK235 zv'))) : - zzQ ((zK254 zv)) := by - zzK1 zK254 zK235 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS235 (zv : zzV) : zzQ ((zK235 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK235 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK235 zK253 h_vl (zS253 (zzF2 (zv 1) (zv 2))) - · zzK2 zK235 zK254 h_vl (zA254 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS220 (zv : zzV) : zzQ ((zK220 zv)) := by zzK1 zK220 zK235 (zS235 (zzF3 (zv 0) (1) (zv 1))) -lemma zS207 (zv : zzV) : zzQ ((zK207 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK207 zK129 h_vl (zS129 (zzF1 (zv 1))) - · zzK2 zK207 zK220 h_vl (zS220 (zzF2 (l) (zv 1))) -lemma zS196 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK196 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK196 zK207 h_vr (zS207 (zzF2 (zv 0) (zv 2))) - · zzK2 zK196 zP208 h_vr (h_208 (zzF3 (zv 0) (r) (zv 2)) (by (try simp only []); omega)) -lemma zS178 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK178 zv)) := by zzK1 zK178 zK196 (zS196 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS165 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK165 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK165 zK177 h_vr (zS177 (zzF2 (1) (zv 1))) - · zzK2 zK165 zK178 h_vr (zS178 B h_208 (zzF3 (1) (r) (zv 1)) (by (try simp only []); omega)) -lemma zS155 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK155 zv)) := by zzK1 zK155 zK165 (zS165 B h_208 (zzF2 (zv 0) (zv 1)) (by (try simp only []); omega)) -lemma zS197 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK197 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK197 zK177 h_vr (zS177 (zzF2 ((zv 0 + 1)) (zv 2))) - · zzK2 zK197 zK178 h_vr (zS178 B h_208 (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) -lemma zS179 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK179 zv)) := by zzK1 zK179 zK197 (zS197 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zA198 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) - (h_u : ∀ zv', zv' 1 < zv 1 -> zv' 2 <= B -> zzQ ((zK180 zv'))) : - zzQ ((zK198 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK198 zK179 h_vr (zS179 B h_208 (zzF3 ((zv 0 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega)) - · zzK2 zK198 zK180 h_vr (h_u (zzF4 ((zv 0 + 1)) (r) (zv 2) (zv 3)) (by (try simp only []); omega) (by (try simp only []); omega)) -lemma zS180 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) : zzQ ((zK180 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zv 2 <= B -> zzQ ((zK180 zv)) from h_ind (zv 1) zv rfl h_B - intro n - refine Nat.strongRecOn n (fun n ih zv h_n h_B => ?_) - zzK1 zK180 zK198 (zA198 B h_208 (zzF4 (zv 0) (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega) (fun zv' h_le h_B' => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl h_B')) -lemma zS166 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK166 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK166 zK179 h_vr (zS179 B h_208 (zzF3 (1) (zv 1) (zv 2)) (by (try simp only []); omega)) - · zzK2 zK166 zK180 h_vr (zS180 B h_208 (zzF4 (1) (r) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS156 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK156 zv)) := by zzK1 zK156 zK166 (zS166 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS148 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK148 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK148 zK155 h_vr (zS155 B h_208 (zzF2 (zv 1) (zv 2)) (by (try simp only []); omega)) - · zzK2 zK148 zK156 h_vr (zS156 B h_208 (zzF3 (r) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS142 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK142 zv)) := by zzK1 zK142 zK148 (zS148 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS138 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK138 zv)) := by zzK1 zK138 zK142 (zS142 B h_208 (zzF3 (zv 0) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS134 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK134 zv)) := by zzK1 zK134 zK138 (zS138 B h_208 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zA130 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 0 <= B) : zzQ ((zK130 zv)) := by zzK1 zK130 zK134 (zS134 B h_208 (zzF3 (1) (zv 0) (zv 1)) (by (try simp only []); omega)) -lemma zS255 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK255 zv)) := by zzK1 zK255 zK134 (zS134 B h_208 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zA256 (zv : zzV) (B : Nat) (h_B : zv 2 <= B) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zv' 2 <= B -> zzQ ((zK236 zv'))) : - zzQ ((zK256 zv)) := by - zzK1 zK256 zK236 (h_u (zzF4 (zv 0) ((zv 1 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega) (by (try simp only []); omega)) -lemma zS236 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 2 <= B) : zzQ ((zK236 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zv 2 <= B -> zzQ ((zK236 zv)) from h_ind (zv 0) zv rfl h_B - intro n - refine Nat.strongRecOn n (fun n ih zv h_n h_B => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK236 zK255 h_vl (zS255 B h_208 (zzF3 (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega)) - · zzK2 zK236 zK256 h_vl (zA256 (zzF4 (l) (zv 1) (zv 2) (zv 3)) B (by (try simp only []); omega) (fun zv' h_le h_B' => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl h_B')) -lemma zS221 (B : Nat) (h_208 : ∀ zv', zv' 1 < B -> zzQ ((zzE zP208 zv'))) (zv : zzV) (h_B : zv 1 <= B) : zzQ ((zK221 zv)) := by zzK1 zK221 zK236 (zS236 B h_208 (zzF4 (zv 0) (1) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma step_hub_208 (zv : zzV) : zzQ ((zzE zP208 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zzE zP208 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zP208 zK130 h_vl (zA130 n (fun zv' h_lt => ih (zv' 1) h_lt zv' rfl) (zzF2 (zv 1) (zv 2)) (by (try simp only []); omega)) - · zzK2 zP208 zK221 h_vl (zS221 n (fun zv' h_lt => ih (zv' 1) h_lt zv' rfl) (zzF3 (l) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS130 (zv : zzV) : - zzQ ((zK130 zv)) := - zA130 (zv 0) (fun zv' _ => step_hub_208 zv') zv (Nat.le_refl _) -lemma zS126 (zv : zzV) : zzQ ((zK126 zv)) := by zzK1 zK126 zK130 (zS130 (zzF2 (zv 0) (zv 1))) -lemma zS122 (zv : zzV) : zzQ ((zK122 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK122 zK125 h_vr (zS125 (zzF1 (zv 1))) - · zzK2 zK122 zK126 h_vr (zS126 (zzF2 (r) (zv 1))) -lemma zS120 (zv : zzV) : zzQ ((zK120 zv)) := by zzK1 zK120 zK122 (zS122 (zzF2 (zv 0) (zv 1))) -lemma zS118 (zv : zzV) : zzQ ((zK118 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK118 zK119 h_vr (zS119 (zzF1 (zv 1))) - · zzK2 zK118 zK120 h_vr (zS120 (zzF2 (r) (zv 1))) -lemma zS116 (zv : zzV) : zzQ ((zK116 zv)) := by zzK1 zK116 zK118 (zS118 (zzF2 (zv 0) (zv 1))) -lemma zS114 (zv : zzV) : zzQ ((zK114 zv)) := by zzK1 zK114 zK116 (zS116 (zzF2 (zv 0) (zv 1))) -lemma zS111 (zv : zzV) : zzQ ((zK111 zv)) := by zzK1 zK111 zK114 (zS114 (zzF2 (1) (zv 0))) -lemma zS108 (zv : zzV) : zzQ ((zK108 zv)) := by zzK1 zK108 zK111 (zS111 (zzF1 (zv 0))) -lemma zS106 (zv : zzV) : zzQ ((zK106 zv)) := by zzK1 zK106 zK108 (zS108 (zzF1 (zv 0))) -lemma zS104 (zv : zzV) : zzQ ((zK104 zv)) := by zzK1 zK104 zK106 (zS106 (zzF1 (zv 0))) -lemma zS117 (zv : zzV) : zzQ ((zK117 zv)) := by zzK1 zK117 zK114 (zS114 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS115 (zv : zzV) : zzQ ((zK115 zv)) := by zzK1 zK115 zK117 (zS117 (zzF2 (zv 0) (zv 1))) -lemma zS112 (zv : zzV) : zzQ ((zK112 zv)) := by zzK1 zK112 zK115 (zS115 (zzF2 (zv 0) (zv 1))) -lemma zS109 (zv : zzV) : zzQ ((zK109 zv)) := by zzK1 zK109 zK112 (zS112 (zzF2 (zv 0) (zv 1))) -lemma zA113 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK110 zv'))) : - zzQ ((zK113 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK113 zK109 h_vl (zS109 (zzF2 ((zv 1 + 1)) (zv 2))) - · zzK2 zK113 zK110 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS110 (zv : zzV) : zzQ ((zK110 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK110 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK110 zK113 (zA113 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS107 (zv : zzV) : zzQ ((zK107 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK107 zK109 h_vl (zS109 (zzF2 (1) (zv 1))) - · zzK2 zK107 zK110 h_vl (zS110 (zzF3 (l) (1) (zv 1))) -lemma zS105 (zv : zzV) : zzQ ((zK105 zv)) := by zzK1 zK105 zK107 (zS107 (zzF2 (zv 0) (zv 1))) -lemma zS103 (zv : zzV) : zzQ ((zK103 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK103 zK104 h_vl (zS104 (zzF1 (zv 1))) - · zzK2 zK103 zK105 h_vl (zS105 (zzF2 (l) (zv 1))) -lemma zS102 (zv : zzV) : zzQ ((zK102 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK102 zK19 h_vr (zS19 (zzF1 (1))) - · zzK2 zK102 zK103 h_vr (zS103 (zzF2 (1) (r))) -lemma zS101 (zv : zzV) : zzQ ((zK101 zv)) := by zzK1 zK101 zK102 (zS102 (zzF1 (zv 0))) -lemma zS100 (zv : zzV) : zzQ ((zK100 zv)) := by zzK1 zK100 zK101 (zS101 (zzF1 (zv 0))) -lemma zS99 (zv : zzV) : zzQ ((zK99 zv)) := by zzK1 zK99 zK100 (zS100 (zzF1 (zv 0))) -lemma zS98 (zv : zzV) : zzQ ((zK98 zv)) := by zzK1 zK98 zK99 (zS99 (zzF1 (zv 0))) -lemma zS97 (zv : zzV) : zzQ ((zK97 zv)) := by zzK1 zK97 zK98 (zS98 (zzF1 (zv 0))) -lemma zS96 (zv : zzV) : zzQ ((zK96 zv)) := by zzK1 zK96 zK97 (zS97 (zzF1 (zv 0))) -lemma zS95 (zv : zzV) : zzQ ((zK95 zv)) := by zzK1 zK95 zK96 (zS96 (zzF1 (zv 0))) -lemma zS94 (zv : zzV) : zzQ ((zK94 zv)) := by zzK1 zK94 zK95 (zS95 (zzF1 (zv 0))) -lemma zS90 (zv : zzV) : zzQ ((zK90 zv)) := by zzK1 zK90 zK94 (zS94 (zzF1 (zv 0))) -lemma zS86 (zv : zzV) : zzQ ((zK86 zv)) := by zzK1 zK86 zK90 (zS90 (zzF1 (zv 0))) -lemma zA91 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK87 zv'))) : - zzQ ((zK91 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK91 zK86 h_vl (zS86 (zzF1 ((zv 1 + 1)))) - · zzK2 zK91 zK87 h_vl (h_u (zzF2 (l) ((zv 1 + 1))) (by (try simp only []); omega)) -lemma zS87 (zv : zzV) : zzQ ((zK87 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK87 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK87 zK91 (zA91 (zzF2 (zv 0) (zv 1)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS84 (zv : zzV) : zzQ ((zK84 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK84 zK86 h_vl (zS86 (zzF1 (1))) - · zzK2 zK84 zK87 h_vl (zS87 (zzF2 (l) (1))) -lemma zS82 (zv : zzV) : zzQ ((zK82 zv)) := by zzK1 zK82 zK84 (zS84 (zzF1 (zv 0))) -lemma zS79 (zv : zzV) : zzQ ((zK79 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK79 zK3 h_vl (zS3 (fun _ => 0)) - · zzK2 zK79 zK82 h_vl (zS82 (zzF1 (l))) -lemma zS72 (zv : zzV) : zzQ ((zK72 zv)) := by zzK1 zK72 zK79 (zS79 (zzF1 (zv 0))) -lemma zS67 (zv : zzV) : zzQ ((zK67 zv)) := by zzK1 zK67 zK72 (zS72 (zzF1 (zv 0))) -lemma zS62 (zv : zzV) : zzQ ((zK62 zv)) := by zzK1 zK62 zK67 (zS67 (zzF1 (1))) -lemma zS59 (zv : zzV) : zzQ ((zK59 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK59 zK62 h_vr (zS62 (fun _ => 0)) - · zzKB2 zK59 zK63 h_vr (zI63 (zzF1 (r))) -lemma zS56 (zv : zzV) : zzQ ((zK56 zv)) := by zzK1 zK56 zK59 (zS59 (zzF1 (zv 0))) -lemma zS75 (zv : zzV) : zzQ ((zK75 zv)) := by zzK1 zK75 zK67 (zS67 (zzF1 ((zv 0 + 1)))) -lemma zS69 (zv : zzV) : zzQ ((zK69 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK69 zK75 h_vr (zS75 (zzF1 (zv 0))) - · zzKB2 zK69 zK76 h_vr (zI76 (zzF2 (zv 0) (r))) -lemma zS64 (zv : zzV) : zzQ ((zK64 zv)) := by zzK1 zK64 zK69 (zS69 (zzF2 (1) (zv 0))) -lemma zS77 (zv : zzV) : zzQ ((zK77 zv)) := by zzK1 zK77 zK69 (zS69 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA78 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK70 zv'))) : - zzQ ((zK78 zv)) := by - zzK1 zK78 zK70 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS70 (zv : zzV) : zzQ ((zK70 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK70 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK70 zK77 h_vr (zS77 (zzF2 (zv 0) (zv 2))) - · zzK2 zK70 zK78 h_vr (zA78 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS65 (zv : zzV) : zzQ ((zK65 zv)) := by zzK1 zK65 zK70 (zS70 (zzF3 (1) (zv 0) (zv 1))) -lemma zS60 (zv : zzV) : zzQ ((zK60 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK60 zK64 h_vr (zS64 (zzF1 (zv 1))) - · zzK2 zK60 zK65 h_vr (zS65 (zzF2 (r) (zv 1))) -lemma zS57 (zv : zzV) : zzQ ((zK57 zv)) := by zzK1 zK57 zK60 (zS60 (zzF2 (zv 0) (zv 1))) -lemma zS54 (zv : zzV) : zzQ ((zK54 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK54 zK56 h_vr (zS56 (zzF1 (zv 1))) - · zzK2 zK54 zK57 h_vr (zS57 (zzF2 (r) (zv 1))) -lemma zS52 (zv : zzV) : zzQ ((zK52 zv)) := by zzK1 zK52 zK54 (zS54 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS50 (zv : zzV) : zzQ ((zK50 zv)) := by zzK1 zK50 zK52 (zS52 (zzF2 (1) (zv 0))) -lemma zS48 (zv : zzV) : zzQ ((zK48 zv)) := by zzK1 zK48 zK50 (zS50 (zzF1 (zv 0))) -lemma zS46 (zv : zzV) : zzQ ((zK46 zv)) := by zzK1 zK46 zK48 (zS48 (zzF1 (zv 0))) -lemma zS43 (zv : zzV) : zzQ ((zK43 zv)) := by zzK1 zK43 zK46 (zS46 (zzF1 (zv 0))) -lemma zS38 (zv : zzV) : zzQ ((zK38 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK38 zK42 h_vr (zS42 (fun _ => 0)) - · zzK2 zK38 zK43 h_vr (zS43 (zzF1 (r))) -lemma zS34 (zv : zzV) : zzQ ((zK34 zv)) := by zzK1 zK34 zK38 (zS38 (zzF1 (zv 0))) -lemma zS71 (zv : zzV) : zzQ ((zK71 zv)) := by zzKB1 zK71 zP66 (zI66 (zzF1 ((zv 0 + 1)))) -lemma zA80 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK73 zv'))) : - zzQ ((zK80 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK80 zK47 h_vl (zS47 (fun _ => 0)) - · zzK2 zK80 zK73 h_vl (h_u (zzF1 (l)) (by (try simp only []); omega)) -lemma zS73 (zv : zzV) : zzQ ((zK73 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK73 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK73 zK80 (zA80 (zzF1 (zv 0)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS92 (zv : zzV) : zzQ ((zK92 zv)) := by zzK1 zK92 zK52 (zS52 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS88 (zv : zzV) : zzQ ((zK88 zv)) := by zzK1 zK88 zK92 (zS92 (zzF2 (zv 0) (zv 1))) -lemma zA93 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK89 zv'))) : - zzQ ((zK93 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK93 zK88 h_vl (zS88 (zzF2 ((zv 1 + 1)) (zv 2))) - · zzK2 zK93 zK89 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS89 (zv : zzV) : zzQ ((zK89 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK89 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK89 zK93 (zA93 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS85 (zv : zzV) : zzQ ((zK85 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK85 zK88 h_vl (zS88 (zzF2 (1) (zv 1))) - · zzK2 zK85 zK89 h_vl (zS89 (zzF3 (l) (1) (zv 1))) -lemma zS83 (zv : zzV) : zzQ ((zK83 zv)) := by zzK1 zK83 zK85 (zS85 (zzF2 (zv 0) (zv 1))) -lemma zS81 (zv : zzV) : zzQ ((zK81 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK81 zK48 h_vl (zS48 (zzF1 (zv 1))) - · zzK2 zK81 zK83 h_vl (zS83 (zzF2 (l) (zv 1))) -lemma zS74 (zv : zzV) : zzQ ((zK74 zv)) := by zzK1 zK74 zK81 (zS81 (zzF2 (zv 0) (zv 1))) -lemma zS170 (zv : zzV) : zzQ ((zK170 zv)) := by zzK1 zK170 zK104 (zS104 (zzF1 (zv 0))) -lemma zS160 (zv : zzV) : zzQ ((zK160 zv)) := by zzK1 zK160 zK170 (zS170 (zzF1 (zv 0))) -lemma zS151 (zv : zzV) : zzQ ((zK151 zv)) := by zzK1 zK151 zK160 (zS160 (zzF1 (zv 0))) -lemma zS145 (zv : zzV) : zzQ ((zK145 zv)) := by zzK1 zK145 zK151 (zS151 (zzF1 (zv 0))) -lemma zS186 (zv : zzV) : zzQ ((zK186 zv)) := by zzK1 zK186 zK103 (zS103 (zzF2 (zv 0) (zv 1))) -lemma zS171 (zv : zzV) : zzQ ((zK171 zv)) := by zzK1 zK171 zK186 (zS186 (zzF2 (zv 0) (zv 1))) -lemma zS161 (zv : zzV) : zzQ ((zK161 zv)) := by zzK1 zK161 zK171 (zS171 (zzF2 (1) (zv 0))) -lemma zS187 (zv : zzV) : zzQ ((zK187 zv)) := by zzK1 zK187 zK171 (zS171 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA188 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK172 zv'))) : - zzQ ((zK188 zv)) := by - zzK1 zK188 zK172 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS172 (zv : zzV) : zzQ ((zK172 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK172 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK172 zK187 h_vr (zS187 (zzF2 (zv 0) (zv 2))) - · zzK2 zK172 zK188 h_vr (zA188 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS162 (zv : zzV) : zzQ ((zK162 zv)) := by zzK1 zK162 zK172 (zS172 (zzF3 (1) (zv 0) (zv 1))) -lemma zS152 (zv : zzV) : zzQ ((zK152 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK152 zK161 h_vr (zS161 (zzF1 (zv 1))) - · zzK2 zK152 zK162 h_vr (zS162 (zzF2 (r) (zv 1))) -lemma zS146 (zv : zzV) : zzQ ((zK146 zv)) := by zzK1 zK146 zK152 (zS152 (zzF2 (zv 0) (zv 1))) -lemma zS317 (zv : zzV) : zzQ ((zK317 zv)) := by zzK1 zK317 zK28 (zS28 (fun _ => 0)) -lemma zS309 (zv : zzV) : zzQ ((zK309 zv)) := by zzK1 zK309 zK317 (zS317 (fun _ => 0)) -lemma zS310 (zv : zzV) : zzQ ((zK310 zv)) := by zzK1 zK310 zP245 (step_to_ps_245 (zzF1 ((zv 0 + 1)))) -lemma zS305 (zv : zzV) : zzQ ((zK305 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK305 zK309 h_vr (zS309 (fun _ => 0)) - · zzK2 zK305 zK310 h_vr (zS310 (zzF1 (r))) -lemma zS301 (zv : zzV) : zzQ ((zK301 zv)) := by zzK1 zK301 zK305 (zS305 (zzF1 (zv 0))) -lemma zS324 (zv : zzV) : zzQ ((zK324 zv)) := by zzK1 zK324 zP271 (step_to_ps_271 (zzF2 (zv 0) ((zv 1 + 1)))) -lemma zS318 (zv : zzV) : zzQ ((zK318 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK318 zK22 h_vr (zS22 (zzF1 (zv 0))) - · zzK2 zK318 zK324 h_vr (zS324 (zzF2 (zv 0) (r))) -lemma zS311 (zv : zzV) : zzQ ((zK311 zv)) := by zzK1 zK311 zK318 (zS318 (zzF2 (1) (zv 0))) -lemma zS325 (zv : zzV) : zzQ ((zK325 zv)) := by zzK1 zK325 zK318 (zS318 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA326 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK319 zv'))) : - zzQ ((zK326 zv)) := by - zzK1 zK326 zK319 (h_u (zzF3 ((zv 0 + 1)) (zv 1) (zv 2)) (by (try simp only []); omega)) -lemma zS319 (zv : zzV) : zzQ ((zK319 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK319 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK319 zK325 h_vr (zS325 (zzF2 (zv 0) (zv 2))) - · zzK2 zK319 zK326 h_vr (zA326 (zzF3 (zv 0) (r) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS312 (zv : zzV) : zzQ ((zK312 zv)) := by zzK1 zK312 zK319 (zS319 (zzF3 (1) (zv 0) (zv 1))) -lemma zS306 (zv : zzV) : zzQ ((zK306 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK306 zK311 h_vr (zS311 (zzF1 (zv 1))) - · zzK2 zK306 zK312 h_vr (zS312 (zzF2 (r) (zv 1))) -lemma zS302 (zv : zzV) : zzQ ((zK302 zv)) := by zzK1 zK302 zK306 (zS306 (zzF2 (zv 0) (zv 1))) -lemma zS299 (zv : zzV) : zzQ ((zK299 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK299 zK301 h_vr (zS301 (zzF1 (zv 1))) - · zzK2 zK299 zK302 h_vr (zS302 (zzF2 (r) (zv 1))) -lemma zS297 (zv : zzV) : zzQ ((zK297 zv)) := by zzK1 zK297 zK299 (zS299 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS295 (zv : zzV) : zzQ ((zK295 zv)) := by zzK1 zK295 zK297 (zS297 (zzF2 (1) (zv 0))) -lemma zS293 (zv : zzV) : zzQ ((zK293 zv)) := by zzK1 zK293 zK295 (zS295 (zzF1 (zv 0))) -lemma zS291 (zv : zzV) : zzQ ((zK291 zv)) := by zzK1 zK291 zK293 (zS293 (zzF1 (zv 0))) -lemma zS289 (zv : zzV) : zzQ ((zK289 zv)) := by zzK1 zK289 zK291 (zS291 (zzF1 (zv 0))) -lemma zS361 (zv : zzV) : zzQ ((zK361 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK361 zK19 h_vr (zS19 (zzF1 ((zv 0 + 1)))) - · zzK2 zK361 zK103 h_vr (zS103 (zzF2 ((zv 0 + 1)) (r))) -lemma zS359 (zv : zzV) : zzQ ((zK359 zv)) := by zzK1 zK359 zK361 (zS361 (zzF2 (zv 0) (zv 1))) -lemma zA362 (zv : zzV) - (h_u : ∀ zv', zv' 1 < zv 1 -> zzQ ((zK360 zv'))) : - zzQ ((zK362 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK362 zK359 h_vr (zS359 (zzF2 ((zv 0 + 1)) (zv 2))) - · zzK2 zK362 zK360 h_vr (h_u (zzF3 ((zv 0 + 1)) (r) (zv 2)) (by (try simp only []); omega)) -lemma zS360 (zv : zzV) : zzQ ((zK360 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK360 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK360 zK362 (zA362 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS358 (zv : zzV) : zzQ ((zK358 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK358 zK359 h_vr (zS359 (zzF2 (1) (zv 1))) - · zzK2 zK358 zK360 h_vr (zS360 (zzF3 (1) (r) (zv 1))) -lemma zS357 (zv : zzV) : zzQ ((zK357 zv)) := by zzK1 zK357 zK358 (zS358 (zzF2 (zv 0) (zv 1))) -lemma zS352 (zv : zzV) : zzQ ((zK352 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK352 zK101 h_vr (zS101 (zzF1 (zv 1))) - · zzK2 zK352 zK357 h_vr (zS357 (zzF2 (r) (zv 1))) -lemma zS345 (zv : zzV) : zzQ ((zK345 zv)) := by zzK1 zK345 zK352 (zS352 (zzF2 (zv 0) (zv 1))) -lemma zS341 (zv : zzV) : zzQ ((zK341 zv)) := by zzK1 zK341 zK345 (zS345 (zzF2 (zv 0) (zv 1))) -lemma zS337 (zv : zzV) : zzQ ((zK337 zv)) := by zzK1 zK337 zK341 (zS341 (zzF2 (1) (zv 0))) -lemma zS346 (zv : zzV) : zzQ ((zK346 zv)) := by zzK1 zK346 zK341 (zS341 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zA347 (zv : zzV) - (h_u : ∀ zv', zv' 0 <= zv 0 -> zzQ ((zK342 zv'))) : - zzQ ((zK347 zv)) := by - zzK1 zK347 zK342 (h_u (zzF3 (zv 0) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS342 (zv : zzV) : zzQ ((zK342 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK342 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vl : zv 0 with _ | l - · zzK2 zK342 zK346 h_vl (zS346 (zzF2 (zv 1) (zv 2))) - · zzK2 zK342 zK347 h_vl (zA347 (zzF3 (l) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS338 (zv : zzV) : zzQ ((zK338 zv)) := by zzK1 zK338 zK342 (zS342 (zzF3 (zv 0) (1) (zv 1))) -lemma zS334 (zv : zzV) : zzQ ((zK334 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK334 zK337 h_vl (zS337 (zzF1 (zv 1))) - · zzK2 zK334 zK338 h_vl (zS338 (zzF2 (l) (zv 1))) -lemma zS327 (zv : zzV) : zzQ ((zK327 zv)) := by zzK1 zK327 zK334 (zS334 (zzF2 (zv 0) (zv 1))) -lemma zS320 (zv : zzV) : zzQ ((zK320 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK320 zK97 h_vl (zS97 (zzF1 (zv 1))) - · zzK2 zK320 zK327 h_vl (zS327 (zzF2 (l) (zv 1))) -lemma zS313 (zv : zzV) : zzQ ((zK313 zv)) := by zzK1 zK313 zK320 (zS320 (zzF2 (1) (zv 0))) -lemma zS307 (zv : zzV) : zzQ ((zK307 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK307 zK313 h_vr (zS313 (zzF1 (zv 1))) - · zzKB2 zK307 zK314 h_vr (zI314 (zzF2 (r) (zv 1))) -lemma zS303 (zv : zzV) : zzQ ((zK303 zv)) := by zzK1 zK303 zK307 (zS307 (zzF2 (zv 0) (zv 1))) -lemma zS330 (zv : zzV) : zzQ ((zK330 zv)) := by zzK1 zK330 zK320 (zS320 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS322 (zv : zzV) : zzQ ((zK322 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zK322 zK330 h_vr (zS330 (zzF2 (zv 0) (zv 2))) - · zzKB2 zK322 zK331 h_vr (zI331 (zzF3 (zv 0) (r) (zv 2))) -lemma zS315 (zv : zzV) : zzQ ((zK315 zv)) := by zzK1 zK315 zK322 (zS322 (zzF3 (1) (zv 0) (zv 1))) -lemma zS332 (zv : zzV) : zzQ ((zK332 zv)) := by zzK1 zK332 zK322 (zS322 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) -lemma zA333 (zv : zzV) - (h_u : ∀ zv', zv' 1 <= zv 1 -> zzQ ((zK323 zv'))) : - zzQ ((zK333 zv)) := by - zzK1 zK333 zK323 (h_u (zzF4 ((zv 0 + 1)) (zv 1) (zv 2) (zv 3)) (by (try simp only []); omega)) -lemma zS323 (zv : zzV) : zzQ ((zK323 zv)) := by - suffices h_ind : ∀ n zv, zv 1 = n -> zzQ ((zK323 zv)) from h_ind (zv 1) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - rcases h_vr : zv 1 with _ | r - · zzK2 zK323 zK332 h_vr (zS332 (zzF3 (zv 0) (zv 2) (zv 3))) - · zzK2 zK323 zK333 h_vr (zA333 (zzF4 (zv 0) (r) (zv 2) (zv 3)) (fun zv' h_le => ih (zv' 1) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS316 (zv : zzV) : zzQ ((zK316 zv)) := by zzK1 zK316 zK323 (zS323 (zzF4 (1) (zv 0) (zv 1) (zv 2))) -lemma zS308 (zv : zzV) : zzQ ((zK308 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK308 zK315 h_vr (zS315 (zzF2 (zv 1) (zv 2))) - · zzK2 zK308 zK316 h_vr (zS316 (zzF3 (r) (zv 1) (zv 2))) -lemma zS304 (zv : zzV) : zzQ ((zK304 zv)) := by zzK1 zK304 zK308 (zS308 (zzF3 (zv 0) (zv 1) (zv 2))) -lemma zS300 (zv : zzV) : zzQ ((zK300 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK300 zK303 h_vr (zS303 (zzF2 (zv 1) (zv 2))) - · zzK2 zK300 zK304 h_vr (zS304 (zzF3 (r) (zv 1) (zv 2))) -lemma zS298 (zv : zzV) : zzQ ((zK298 zv)) := by zzK1 zK298 zK300 (zS300 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) -lemma zS296 (zv : zzV) : zzQ ((zK296 zv)) := by zzK1 zK296 zK298 (zS298 (zzF3 (1) (zv 0) (zv 1))) -lemma zS294 (zv : zzV) : zzQ ((zK294 zv)) := by zzK1 zK294 zK296 (zS296 (zzF2 (zv 0) (zv 1))) -lemma zS292 (zv : zzV) : zzQ ((zK292 zv)) := by zzK1 zK292 zK294 (zS294 (zzF2 (zv 0) (zv 1))) -lemma zS290 (zv : zzV) : zzQ ((zK290 zv)) := by zzK1 zK290 zK292 (zS292 (zzF2 (zv 0) (zv 1))) -lemma zS288 (zv : zzV) : zzQ ((zK288 zv)) := by - rcases h_vr : zv 0 with _ | r - · zzK2 zK288 zK289 h_vr (zS289 (zzF1 (zv 1))) - · zzK2 zK288 zK290 h_vr (zS290 (zzF2 (r) (zv 1))) -lemma zS287 (zv : zzV) : zzQ ((zK287 zv)) := by zzK1 zK287 zK288 (zS288 (zzF2 (zv 0) (zv 1))) -lemma zS353 (zv : zzV) : zzQ ((zK353 zv)) := by zzK1 zK353 zK297 (zS297 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma zS348 (zv : zzV) : zzQ ((zK348 zv)) := by zzK1 zK348 zK353 (zS353 (zzF2 (zv 0) (zv 1))) -lemma zA354 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK349 zv'))) : - zzQ ((zK354 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK354 zK348 h_vl (zS348 (zzF2 ((zv 1 + 1)) (zv 2))) - · zzK2 zK354 zK349 h_vl (h_u (zzF3 (l) ((zv 1 + 1)) (zv 2)) (by (try simp only []); omega)) -lemma zS349 (zv : zzV) : zzQ ((zK349 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK349 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK349 zK354 (zA354 (zzF3 (zv 0) (zv 1) (zv 2)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS343 (zv : zzV) : zzQ ((zK343 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK343 zK348 h_vl (zS348 (zzF2 (1) (zv 1))) - · zzK2 zK343 zK349 h_vl (zS349 (zzF3 (l) (1) (zv 1))) -lemma zS339 (zv : zzV) : zzQ ((zK339 zv)) := by zzK1 zK339 zK343 (zS343 (zzF2 (zv 0) (zv 1))) -lemma zS335 (zv : zzV) : zzQ ((zK335 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK335 zK293 h_vl (zS293 (zzF1 (zv 1))) - · zzK2 zK335 zK339 h_vl (zS339 (zzF2 (l) (zv 1))) -lemma zS328 (zv : zzV) : zzQ ((zK328 zv)) := by zzK1 zK328 zK335 (zS335 (zzF2 (zv 0) (zv 1))) -lemma zS355 (zv : zzV) : zzQ ((zK355 zv)) := by zzK1 zK355 zK298 (zS298 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) -lemma zS350 (zv : zzV) : zzQ ((zK350 zv)) := by zzK1 zK350 zK355 (zS355 (zzF3 (zv 0) (zv 1) (zv 2))) -lemma zA356 (zv : zzV) - (h_u : ∀ zv', zv' 0 < zv 0 -> zzQ ((zK351 zv'))) : - zzQ ((zK356 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK356 zK350 h_vl (zS350 (zzF3 ((zv 1 + 1)) (zv 2) (zv 3))) - · zzK2 zK356 zK351 h_vl (h_u (zzF4 (l) ((zv 1 + 1)) (zv 2) (zv 3)) (by (try simp only []); omega)) -lemma zS351 (zv : zzV) : zzQ ((zK351 zv)) := by - suffices h_ind : ∀ n zv, zv 0 = n -> zzQ ((zK351 zv)) from h_ind (zv 0) zv rfl - intro n - refine Nat.strongRecOn n (fun n ih zv h_n => ?_) - zzK1 zK351 zK356 (zA356 (zzF4 (zv 0) (zv 1) (zv 2) (zv 3)) (fun zv' h_le => ih (zv' 0) (by simp -failIfUnchanged only [] at h_le; omega) zv' rfl)) -lemma zS344 (zv : zzV) : zzQ ((zK344 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK344 zK350 h_vl (zS350 (zzF3 (1) (zv 1) (zv 2))) - · zzK2 zK344 zK351 h_vl (zS351 (zzF4 (l) (1) (zv 1) (zv 2))) -lemma zS340 (zv : zzV) : zzQ ((zK340 zv)) := by zzK1 zK340 zK344 (zS344 (zzF3 (zv 0) (zv 1) (zv 2))) -lemma zS336 (zv : zzV) : zzQ ((zK336 zv)) := by - rcases h_vl : zv 0 with _ | l - · zzK2 zK336 zK294 h_vl (zS294 (zzF2 (zv 1) (zv 2))) - · zzK2 zK336 zK340 h_vl (zS340 (zzF3 (l) (zv 1) (zv 2))) -lemma zS329 (zv : zzV) : zzQ ((zK329 zv)) := by zzK1 zK329 zK336 (zS336 (zzF3 (zv 0) (zv 1) (zv 2))) -lemma step_hub_30_step1 (zv : zzV) : zzQ ((zzE pat_30_step1 zv)) := by - rcases h_vr : zv 0 with _ | r - · have h_eq : zzE pat_30_step1 zv = zK33 (fun _ => 0) := by - simp -failIfUnchanged only [evalTapePattern, pat_30_step1, zK33, evalTapeExpr]; rw [h_vr] - zzS2 - rw [h_eq]; exact zS33 (fun _ => 0) - · have h_eq : zzE pat_30_step1 zv = zK34 (zzF1 (r)) := by - simp -failIfUnchanged only [evalTapePattern, pat_30_step1, zK34, evalTapeExpr]; rw [h_vr] - zzS2 - rw [h_eq]; exact zS34 (zzF1 (r)) -lemma step_hub_66 (zv : zzV) : zzQ ((zzE zP66 zv)) := by zzK1 zP66 zK71 (zS71 (zzF1 (zv 0))) -lemma step_hub_68 (zv : zzV) : zzQ ((zzE zP68 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zP68 zK73 h_vr (zS73 (zzF1 (zv 0))) - · zzK2 zP68 zK74 h_vr (zS74 (zzF2 (zv 0) (r))) -lemma zS76 (zv : zzV) : zzQ ((zK76 zv)) := by zzK1 zK76 zP68 (step_hub_68 (zzF2 ((zv 0 + 1)) (zv 1))) -lemma step_hub_140_step1 (zv : zzV) : zzQ ((zzE pat_140_step1 zv)) := by - rcases h_vr : zv 0 with _ | r - · have h_eq : zzE pat_140_step1 zv = zK145 (zzF1 (zv 1)) := by - simp -failIfUnchanged only [evalTapePattern, pat_140_step1, zK145, evalTapeExpr]; rw [h_vr] - zzS2 - rw [h_eq]; exact zS145 (zzF1 (zv 1)) - · have h_eq : zzE pat_140_step1 zv = zK146 (zzF2 (r) (zv 1)) := by - simp -failIfUnchanged only [evalTapePattern, pat_140_step1, zK146, evalTapeExpr]; rw [h_vr] - zzS2 - rw [h_eq]; exact zS146 (zzF2 (r) (zv 1)) -lemma step_hub_321 (zv : zzV) : zzQ ((zzE zP321 zv)) := by - rcases h_vr : zv 1 with _ | r - · zzK2 zP321 zK328 h_vr (zS328 (zzF2 (zv 0) (zv 2))) - · zzK2 zP321 zK329 h_vr (zS329 (zzF3 (zv 0) (r) (zv 2))) -lemma zS331 (zv : zzV) : zzQ ((zK331 zv)) := by zzK1 zK331 zP321 (step_hub_321 (zzF3 ((zv 0 + 1)) (zv 1) (zv 2))) -lemma step_hub_A3_30 (zv : zzV) (h_cond : evalVarCond zC30 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [zC30, evalVarCond] at h_cond - have h_0 : zv 0 = 0 := by omega - have h_1 : zv 1 = 0 := by omega - have h_2 : zv 2 = 0 := by omega - have h_3 : zv 3 = 0 := by omega - have h_4 : zv 4 = 1 := by omega - have h_6 : zv 6 = 0 := by omega - have h_eq : zzE pat_A3 zv = zzE pat_30_step1 (zzF1 (zv 5)) := by - simp -failIfUnchanged only [pat_A3, pat_30_step1, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_6] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact step_hub_30_step1 (zzF1 (zv 5)) -lemma step_hub_A3_140 (zv : zzV) (h_cond : evalVarCond zC140 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [zC140, evalVarCond] at h_cond - have h_0 : zv 0 = 0 := by omega - have h_1 : zv 1 = 0 := by omega - have h_2 : zv 2 = 1 := by omega - have h_4 : zv 4 = 3 := by omega - have h_5 : zv 5 = 0 := by omega - have h_eq : zzE pat_A3 zv = zzE pat_140_step1 (zzF2 (zv 3) (zv 6)) := by - simp -failIfUnchanged only [pat_A3, pat_140_step1, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_1]; rw [h_2]; rw [h_4]; rw [h_5] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact step_hub_140_step1 (zzF2 (zv 3) (zv 6)) -lemma step_hub_A3_66 (zv : zzV) (h_cond : evalVarCond zC66 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [zC66, evalVarCond] at h_cond - have h_0 : zv 0 = 1 := by omega - have h_2 : zv 2 = 0 := by omega - have h_3 : zv 3 = 0 := by omega - have h_4 : zv 4 = 0 := by omega - have h_5 : zv 5 = 0 := by omega - have h_6 : zv 6 = 0 := by omega - have h_eq : zzE pat_A3 zv = zzE zP66 (zzF1 (zv 1)) := by - simp -failIfUnchanged only [pat_A3, zP66, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact step_hub_66 (zzF1 (zv 1)) -lemma step_hub_A3_76 (zv : zzV) (h_cond : evalVarCond zC76 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [zC76, evalVarCond] at h_cond - have h_0 : zv 0 = 0 := by omega - have h_1 : zv 1 = (zv 1 - 1) + 1 := by omega - have h_2 : zv 2 = 0 := by omega - have h_3 : zv 3 = 0 := by omega - have h_4 : zv 4 = 1 := by omega - have h_5 : zv 5 = (zv 5 - 1) + 1 := by omega - have h_6 : zv 6 = 0 := by omega - have h_eq : zzE pat_A3 zv = zK76 (zzF2 ((zv 1 - 1)) ((zv 5 - 1))) := by - simp -failIfUnchanged only [pat_A3, zK76, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact zS76 (zzF2 ((zv 1 - 1)) ((zv 5 - 1))) -lemma step_hub_A3_331 (zv : zzV) (h_cond : evalVarCond zC331 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [zC331, evalVarCond] at h_cond - have h_0 : zv 0 = 0 := by omega - have h_2 : zv 2 = 0 := by omega - have h_3 : zv 3 = 0 := by omega - have h_4 : zv 4 = 1 := by omega - have h_5 : zv 5 = (zv 5 - 1) + 1 := by omega - have h_6 : zv 6 = (zv 6 - 1) + 1 := by omega - rcases h_1 : zv 1 with _ | v1 - · have h_eq : zzE pat_A3 zv = zK287 (zzF2 ((zv 5 - 1)) ((zv 6 - 1))) := by - simp -failIfUnchanged only [pat_A3, zK287, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact zS287 (zzF2 ((zv 5 - 1)) ((zv 6 - 1))) - · have h_eq : zzE pat_A3 zv = zK331 (zzF3 (v1) ((zv 5 - 1)) ((zv 6 - 1))) := by - simp -failIfUnchanged only [pat_A3, zK331, evalTapePattern, evalTapeExpr] - rw [h_0]; rw [h_1]; rw [h_2]; rw [h_3]; rw [h_4]; rw [h_5]; rw [h_6] - simp only [Nat.add_sub_cancel, zPz, zPsl, zCal, List.singleton_append, List.nil_append, zLan, zLac, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, zZcd, zDh, zDt] - rw [h_eq] - exact zS331 (zzF3 (v1) ((zv 5 - 1)) ((zv 6 - 1))) -lemma step_hub_A3 (zv : zzV) (h_cond : evalVarCond cond_A3 zv) : zzQ ((zzE pat_A3 zv)) := by - simp -failIfUnchanged [cond_A3, evalVarCond] at h_cond - rcases h_cond with h_cond | h_cond - · exact step_hub_A3_30 zv h_cond - rcases h_cond with h_cond | h_cond - · exact step_hub_A3_140 zv h_cond - rcases h_cond with h_cond | h_cond - · exact step_hub_A3_66 zv h_cond - rcases h_cond with h_cond | h_cond - · exact step_hub_A3_76 zv h_cond - exact step_hub_A3_331 zv h_cond -lemma init_reaches_ps : ∃ cfg_0, ((init []) [target_tm]⊢* cfg_0) /\ IsInPatternSet ps cfg_0 := by - exact ⟨zzE pat_30_step1 (fun _ => 0), init_reaches_pat_30_step1, in_ps_30_step1 (fun _ => 0)⟩ -theorem is_cryptid_proof (_ : True := trivial) : IsCryptid target_tm := by - refine ⟨ps, by decide, init_reaches_ps, ?_⟩ - intro cfg h_in - rcases h_in with ⟨entry, h_mem, zv, rfl, h_cond⟩ - rcases h_mem with ⟨⟩ | ⟨_, h_mem⟩ - · exact step_hub_A3 zv h_cond - · nomatch h_mem -end Solution +private theorem encode_in_ps : ∀ s, IsInPatternSet ps (encode s) + | .A a c d => by + refine ⟨(pat_A, .true), by simp [ps], fun k => match k with | 0 => a | 1 => c | _ => d, + ?_, trivial⟩ + rfl + | .Run a => by + refine ⟨(pat_Run, .true), by simp [ps], fun _ => a, ?_, trivial⟩ + rfl -end Solution +private theorem of_in_ps : ∀ cfg, IsInPatternSet ps cfg → ∃ s, cfg = encode s := by + rintro cfg ⟨⟨pat, cond⟩, hmem, v, rfl, _⟩ + simp only [ps, List.mem_cons, List.not_mem_nil, or_false, Prod.mk.injEq] at hmem + rcases hmem with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · exact ⟨.A (v 0) (v 1) (v 2), rfl⟩ + · exact ⟨.Run (v 0), rfl⟩ --- END EXPLORATORY DEFINITIONS AND LEMMAS +/-- Level A closed pattern-set invariant for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem is_closed_pattern_set : IsClosedPatternSet target ps := by + refine is_valid_acceleration.isClosedPatternSet encode_in_ps of_in_ps ?_ + intro s hnext + cases s with + | Run _ => simp [next] at hnext + | A a c d => + rcases a with _ | _ | a + · rcases d with _ | _ | d + · exact step_A0_c0_halt c + · simp [next] at hnext + · simp [next] at hnext + · change next (.A 1 c d) = none at hnext + rcases d with _ | _ | d <;> simp only [next] at hnext <;> split_ifs at hnext + · simp [next] at hnext --- BEGIN GOAL STATEMENT (DO NOT MODIFY SIGNATURE) +/-- Level A Collatz-like reduction for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem has_collatz_reduction : HasCollatzReduction target := + ⟨ps, is_closed_pattern_set⟩ -set_option linter.unusedVariables false -set_option linter.unusedSimpArgs false -set_option linter.deprecated false -set_option linter.dupNamespace false -set_option linter.unreachableTactic false -set_option linter.unusedTactic false -set_option quotPrecheck false -set_option maxRecDepth 4000000 -set_option maxHeartbeats 8000000 -open Solution in -theorem is_cryptid : IsCryptid target_tm := Solution.is_cryptid_proof +/-- Rule-bounded cryptid certificate for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem is_cryptid : IsCryptid target := + ⟨ps, by decide, is_closed_pattern_set⟩ end BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE diff --git a/BusyBeaver/BB6/README.md b/BusyBeaver/BB6/README.md index d6fa8ef3..8456c075 100644 --- a/BusyBeaver/BB6/README.md +++ b/BusyBeaver/BB6/README.md @@ -1,6 +1,6 @@ # Busy Beaver 6 Holdouts (`BusyBeaver/BB6/`) -This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 55 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines (the [A6 nonhalting certificate](../../artifacts/a6/README.md), 54 closed-pattern holdouts including a Baker-free 2-adic Laurent-determinant non-halting proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---` and `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`), together with 56 stacked, odometer, transducer, and cryptid holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations, and 21 Hard holdout cryptid machines under `IsSegmentedCryptid`, `IsStackCryptid`, and `IsOdometerCryptid`) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (111 `BB(6)` holdouts total), alongside 191 resolved `BB(6)` holdouts categorized under **[`BusyBeaver/BB6/Halt/`](./Halt/)** (32 kernel-verified halting machines, `IsHalt`) and **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)** (159 kernel-verified non-halting machines, `IsNotHalt`), resolving machines from the `bbchallenge` holdout set and `busycoq` formalizations (302 distinct `BB(6)` machines overall). Each machine module in `BusyBeaver/BB6/` below exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. +This directory contains formal Lean 4 specifications and kernel-verified Collatz-like reductions for 55 Busy Beaver 6 (`BB(6)`, 6-state 2-symbol) holdout Turing machines (the [A6 nonhalting certificate](../../artifacts/a6/README.md), 54 closed-pattern holdouts including a Baker-free 2-adic Laurent-determinant non-halting proof for `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`), together with 56 stacked, odometer, transducer, and cryptid holdouts (15 machines formalized under `HasStackReduction`, `HasOdometerReduction`, and `HasTransducerReduction`—12 `bbchallenge` Wiki machines and 3 Halving Tower holdouts—20 open acceleration problems under `IsValidAcceleration`, 13 with higher-level accelerations, and 21 Hard holdout cryptid machines under `IsSegmentedCryptid`, `IsStackCryptid`, and `IsOdometerCryptid`) in **[`BusyBeaver/BB6/Accelerations/`](./Accelerations/README.md)** (111 `BB(6)` holdouts total), alongside 191 resolved `BB(6)` holdouts categorized under **[`BusyBeaver/BB6/Halt/`](./Halt/)** (32 kernel-verified halting machines, `IsHalt`) and **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)** (159 kernel-verified non-halting machines, `IsNotHalt`), resolving machines from the `bbchallenge` holdout set and `busycoq` formalizations (302 distinct `BB(6)` machines overall). Each machine module in `BusyBeaver/BB6/` below (other than the A6 module) exposes both **Level A** (`ps`, `is_closed_pattern_set`, `has_collatz_reduction`, with `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` also proving `IsCryptid`) and **Level B** (`State`, `start`, `encode`, `next`, `is_valid_acceleration`, `isHalt_iff_acceleration`), and 33 modules (all 20 novel discovery modules together with 13 multi-family or multi-counter wiki/busycoq holdouts) additionally expose a higher-level Collatz-like acceleration (`HighLevelState`, `highLevelStart`, `highLevelEncode`, `highLevelNext`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`); see [`BusyBeaver/README.md`](../README.md) for definitions of the behavioral predicates and [`BusyBeaver/BB6/Accelerations/README.md`](./Accelerations/README.md) for the stacked, odometer, and transducer formalizations and open problem statements. The A6 module exports a closed blank-tape `IsNotHalt` proof using a checked entry certificate and a universal return family; it has a separate @@ -46,7 +46,7 @@ entry certificate and a universal return family; it has a separate | `1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LF---_0RA1LA` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LFHHH_0RA1LA.lean`](./M_1RB1LC_1RC0RF_1RD0LB_1RE0LD_1LFHHH_0RA1LA.lean) | | `1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_---1RD` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_HHH1RD.lean`](./M_1RB1LD_1RC0RA_1LA1RE_0LA0LB_0RB1RF_HHH1RD.lean) | | `1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_---0RC` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_---0RC) | [`M_1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_HHH0RC.lean`](./M_1RB1LD_1RC1RE_0LA1LB_0LD1LC_1RF0RA_HHH0RC.lean) | -| `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` | `6` | `2` | `IsCryptid` | — | [`M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean`](./M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean) | +| `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsCryptid`, `IsValidAcceleration` | — | [`M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean`](./M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean) | | `1RB1LE_1LB1LC_1RD0LE_---0RB_1RF1LA_0RA0RD` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki (`Cryptids`)](https://wiki.bbchallenge.org/wiki/Cryptids) | [`M_1RB1LE_1LB1LC_1RD0LE_HHH0RB_1RF1LA_0RA0RD.lean`](./M_1RB1LE_1LB1LC_1RD0LE_HHH0RB_1RF1LA_0RA0RD.lean) | | `1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_---1RC` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | [Wiki](https://wiki.bbchallenge.org/wiki/1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_---1RC) (TMBR Aug 2025) | [`M_1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_HHH1RC.lean`](./M_1RB1LE_1LC0RA_0RF0LD_1LE1LA_1RC0LB_HHH1RC.lean) | | `1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_---0RE` | `6` | `2` | `IsClosedPatternSet`, `HasCollatzReduction`, `IsValidAcceleration` | — | [`M_1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_HHH0RE.lean`](./M_1RB1LE_1RC1RA_0LD1RB_1LE1LD_1RF0LA_HHH0RE.lean) | @@ -1025,10 +1025,10 @@ Under $(a, d) = (c, b + 1)$ (for $d \ge 1$), this map is identical to that of [` ## Resolved `BB(6)` Machines -This directory formalizes 192 resolved `BB(6)` Turing machines reproducing community proofs and `busycoq` results directly verified in Lean 4 without axioms (`sorry`-free and `native_decide`-free kernel verification): +This directory formalizes 191 resolved `BB(6)` Turing machines (plus `IsNotHalt` on `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---` in [`BusyBeaver/BB6/`](./)) reproducing community proofs and `busycoq` results directly verified in Lean 4 without axioms (`sorry`-free and `native_decide`-free kernel verification): - **[`BusyBeaver/BB6/Halt/`](./Halt/)**: 32 resolved halting machines (`IsHalt`), each reaching a halting configuration from `init []` with verified multi-step traces. -- **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)**: 160 resolved non-halting machines (`IsNotHalt`), verified via inductive invariants, simulated cycles, or closed-set reachability certificates. +- **[`BusyBeaver/BB6/NonHalt/`](./NonHalt/)**: 159 resolved non-halting machines (`IsNotHalt`; 160 `IsNotHalt` entries in the table below including `1RB1LA_1RC1RE_1LD0RB_1LA0LC_0RF0RD_0RB---`), verified via inductive invariants, simulated cycles, or closed-set reachability certificates. ### Resolved BB(6) Halt Machines (32 machines) diff --git a/BusyBeaver/Defs/Segmented.lean b/BusyBeaver/Defs/Segmented.lean index d43dae97..671e7ff1 100644 --- a/BusyBeaver/Defs/Segmented.lean +++ b/BusyBeaver/Defs/Segmented.lean @@ -47,58 +47,72 @@ def evalSegmentedHalf {Γ : Type u} [Inhabited Γ] : List (SegRegionKind Γ) → | [] => default | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) -/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the - valid states): every finite window of every valid half-tape extends to a half-tape that no - valid state encodes, i.e. the image has empty interior in the prefix topology. A - bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family - certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ -def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] - (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := - ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, - (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad +/-- Structural well-formedness for a `SegRegionKind`: non-empty periodic/word blocks, bounded + `.gadget` literals (`w.length ≤ 16`), and no full single-symbol raw alphabet wrapping inside + `.wordRun` / `.finWord`. -/ +def SegRegionKind.WellFormed {Γ : Type u} : SegRegionKind Γ → Prop + | .reg blk _ => blk ≠ [] + | .wordRun frames => + (∀ p ∈ frames, p.1 ≠ []) ∧ ¬ ∀ b : Γ, ∃ p ∈ frames, p.1 = [b] + | .finWord words => + (∀ w ∈ words, w ≠ []) ∧ ¬ ∀ b : Γ, [b] ∈ words + | .gadget w => w.length ≤ 16 /-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ def IsNowhereDenseHalf {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) +/-- Closed `≤ 3`-region segmented transition system on an explicit `(SegState, Mode)` carrier. -/ +def IsClosedSegmentedSystem {k : ℕ} {Λ : Type u} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) + {SegState Mode : Type} + (modes : List Mode) + (ValidSeg : SegState → Prop) + (modeOf : SegState → Mode) + (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) + (evalCfg : SegState → Cfg (Fin (k + 2)) Λ) : Prop := + 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ (∀ m : Mode, m ∈ modes) ∧ + (∀ s, ValidSeg s → + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed)) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s))))) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ + (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ + (IsNowhereDenseHalf ValidSeg segsR ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ + (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ + (∀ s, ValidSeg s → + ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + /-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view - prefix). -/ + prefix), and all regions must be `SegRegionKind.WellFormed`. -/ def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] (M : Machine (Fin (k + 2)) Λ) : Prop := - ∃ (SegState : Type) - (Mode : Type) + ∃ (SegState Mode : Type) + (modes : List Mode) (ValidSeg : SegState → Prop) (modeOf : SegState → Mode) (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) (evalCfg : SegState → Cfg (Fin (k + 2)) Λ), - (∃ modes : List Mode, 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ - (∀ s, ValidSeg s → (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3) ∧ - (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), - viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ - ∀ s, ValidSeg s → modeOf s = m → - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), - applyView vL (evalSegmentedHalf (segsL s)), - applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) - (applyView vR (evalSegmentedHalf (segsR s)))) ∨ - (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) - (applyView vR (evalSegmentedHalf (segsR s))))) ∧ - (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ - (IsNowhereDenseHalf ValidSeg segsL ∨ - (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ - (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ - (IsNowhereDenseHalf ValidSeg segsR ∨ - (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ - (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ - (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ - (∀ s, ValidSeg s → - ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ - ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + IsClosedSegmentedSystem M modes ValidSeg modeOf segsL segsR evalCfg end BusyBeaver diff --git a/BusyBeaver/Defs/WordRun.lean b/BusyBeaver/Defs/WordRun.lean index d33d7120..c7ebebf2 100644 --- a/BusyBeaver/Defs/WordRun.lean +++ b/BusyBeaver/Defs/WordRun.lean @@ -79,11 +79,22 @@ def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) section -universe u +universe u v /-- Prefix length of a `HalfTapeView`. -/ def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := - v.casesOn (fun p => p.length) (fun p => p.length) + HalfTapeView.casesOn (motive := fun _ => ℕ) v List.length List.length + +/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the + valid states): every finite window of every valid half-tape extends to a half-tape that no + valid state encodes, i.e. the image has empty interior in the prefix topology. A + bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family + certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ +def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] + (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := + ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, + (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad + end /-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ @@ -273,10 +284,8 @@ def IsWordRunCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] (∀ s, ValidState s → MergedRunFrames specL s.L ∧ MergedRunFrames specR s.R ∧ AnchoredFrames specL s.L ∧ AnchoredFrames specR s.R) ∧ - ((∃ badL : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specL s.regsL s.L ≠ badL) ∨ - IsBoundaryAlignedSide .leftSide specL specR ValidState evalCfg) ∧ - ((∃ badR : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specR s.regsR s.R ≠ badR) ∨ - IsBoundaryAlignedSide .rightSide specL specR ValidState evalCfg) ∧ + IsNowhereDenseFamily ValidState (fun s => encHalf specL s.regsL s.L) ∧ + IsNowhereDenseFamily ValidState (fun s => encHalf specR s.regsR s.R) ∧ (∀ s s', ValidState s → stepMacro s = some s' → ValidState s' ∧ ∃ n, StrictFrameProgress specL specR s s' n ∧ ReachesIn M n (evalCfg s) (evalCfg s')) ∧ diff --git a/BusyBeaver/README.md b/BusyBeaver/README.md index 2b69181d..1b7dc121 100644 --- a/BusyBeaver/README.md +++ b/BusyBeaver/README.md @@ -38,14 +38,14 @@ All proofs in `BusyBeaver/` target machine-checked behavioral predicates startin | `IsNotHalt M` (`IsDoesNotHalt M`) | `Defs/Core.lean` | Every configuration reachable from `init []` has a well-defined successor (`(step M cfg).isSome`). | | `IsClosedPatternSet M ps` | `Defs/Patterns.lean` | **Level A (Counter)**: `M`'s blank-tape trajectory enters the explicit `TapePatternSet` `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | | `HasCollatzReduction M` | `Defs/Patterns.lean` | `∃ ps, IsClosedPatternSet M ps`. | -| `IsCryptid M` | `Defs/Patterns.lean` | `M` admits an invariant certificate with at most 16 patterns and 32 rules over alphabet size `k + 2`. | +| `IsCryptid M` | `Defs/Patterns.lean` | `M` admits a closed `TapePatternSet` invariant certificate `ps` (`IsClosedPatternSet M ps`) with `ps.length ≤ 16`. | | `IsClosedStackPatternSet M ps` | `Defs/Stack.lean` | **Level A (Stacked)**: `ps` is well-formed (`IsWellFormedStackPatternSet ps`: non-empty, blank-free block vocabularies, and single-sided stack configuration with at most one `.word` segment), `M`'s blank-tape trajectory enters `ps`, and every member configuration advances (`ReachesPlus`) either to another member of `ps` or to a halting configuration. | | `HasStackedCollatzReduction M` | `Defs/Stack.lean` | `∃ ps, IsClosedStackPatternSet M ps` (an existential summary paired in `BusyBeaverChallenge.lean` with a concrete `ps` and an explicit Level B finite-state transducer acceleration). | | `HasStackReduction M` | `Defs/Stack.lean` | **Level A (Two-Sided Stack)**: `M`'s blank-tape trajectory enters a closed two-sided variable-length digit-stack system (`StackTuple`, `IsValidStackModes`) with bounded-prefix views, blank-tape multi-digit stack reachability, and an arbitrary-depth stack-frame transfer transition. | | `HasOdometerReduction M` | `Defs/Odometer.lean` | **Level A (Odometer)**: `M`'s blank-tape trajectory enters a closed mixed-radix odometer stack + bit-stream system (`evalOdomR` / `evalOdomL`) with non-trivial odometer stack reachability, certified decrement, zero-capacity drain, reflection, and unconditional push/reflect/halt closure. | | `HasTransducerReduction M` | `Defs/Transducer.lean` | **Level A (Transducer)**: `M`'s blank-tape trajectory enters a closed bidirectional macro-word transducer (`IsValidTransducerModes`, `iterTransducerMacro`) over strict-sub-Kraft block alphabets with a halting-verified exit gate and unbounded sweeps in both directions. | -| `IsWordRunCryptid M` | `Defs/WordRun.lean` | `M`'s blank-tape trajectory enters a closed invariant-relative word-run stack system with bottom accumulator registers. | -| `IsSegmentedCryptid M` | `Defs/Segmented.lean` | `M`'s blank-tape trajectory enters a closed segmented schema over partitioned half-tapes with register, word-run, finite-word, and gadget regions. | +| `IsWordRunCryptid M` | `Defs/WordRun.lean` | `M`'s blank-tape trajectory enters a closed invariant-relative word-run stack system with bottom accumulator registers and nowhere-dense half-tape block families on both sides (`IsNowhereDenseFamily`). | +| `IsSegmentedCryptid M` | `Defs/Segmented.lean` | `M`'s blank-tape trajectory enters a closed segmented schema (`IsClosedSegmentedSystem`) over partitioned half-tapes with well-formed register, word-run, finite-word, and bounded-gadget (`w.length ≤ 16`) regions. | | `IsValidAcceleration M start encode next` | `Defs/Patterns.lean` | **Level B**: `encode : S → Cfg Γ Λ` and `next : S → Option S` form a certified acceleration of `M` from `start : S` (`init []` reaches `encode start`, `next s = some s'` implies `ReachesPlus M (encode s) (encode s')`, and `next s = none` implies halting from `encode s`), yielding `IsHalt M ↔ CollatzHalts next start`. | ## Foundational Lemmas ([`Basic.lean`](./Basic.lean)) @@ -81,7 +81,7 @@ theorem isNotHalt_toBB_iff_not_halts (M : ConjectureMachines.Machine states symb ## Formalized Machine Catalogs -- **[`BB(6)` Holdouts (`BusyBeaver/BB6/`)](./BB6/README.md)** — 54 holdouts (the [A6 nonhalting certificate](../artifacts/a6/README.md) and 53 closed-pattern 6-state 2-symbol holdouts; 312 theorems), **[`BB(6)` Accelerations (`BusyBeaver/BB6/Accelerations/`)](./BB6/Accelerations/README.md)** — 35 stacked, odometer, and transducer holdouts (95 theorems: 15 structural reductions and 20 open acceleration problems, including 13 higher-level accelerations), **[`Equivalences.lean`](./BB6/Equivalences.lean)** (1 halting equivalence theorem), and **[`HardnessEvidence.lean`](./BB6/HardnessEvidence.lean)** (74 live-hazard witness and halting residue-class theorems across 26 `BB(6)` holdouts). +- **[`BB(6)` Holdouts (`BusyBeaver/BB6/`)](./BB6/README.md)** — 55 holdouts (the [A6 nonhalting certificate](../artifacts/a6/README.md) and 54 closed-pattern 6-state 2-symbol holdouts; 318 theorems), **[`BB(6)` Accelerations (`BusyBeaver/BB6/Accelerations/`)](./BB6/Accelerations/README.md)** — 56 stacked, odometer, transducer, and cryptid holdouts (127 theorems: 15 structural reductions, 20 open acceleration problems including 13 higher-level accelerations, and 21 Hard holdouts under `IsSegmentedCryptid` with `IsClosedSegmentedSystem`, `IsStackCryptid`, and `IsOdometerCryptid`), **[`Equivalences.lean`](./BB6/Equivalences.lean)** (1 halting equivalence theorem), and **[`HardnessEvidence.lean`](./BB6/HardnessEvidence.lean)** (74 live-hazard witness and halting residue-class theorems across 26 `BB(6)` holdouts), alongside 191 resolved holdouts in **[`Halt/`](./BB6/Halt/)** (32 `IsHalt`) and **[`NonHalt/`](./BB6/NonHalt/)** (159 `IsNotHalt`). - **[`BB(3, 3)` Holdouts (`BusyBeaver/BB33/`)](./BB33/README.md)** — 6 3-state 3-symbol holdouts (24 theorems). ## Building and Verifying diff --git a/BusyBeaver/Stack.lean b/BusyBeaver/Stack.lean index b3b4e1c2..780639f4 100644 --- a/BusyBeaver/Stack.lean +++ b/BusyBeaver/Stack.lean @@ -9,11 +9,6 @@ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.PairStack -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.unusedVariables false -set_option linter.unusedSimpArgs false - -- ============================================================================ -- Section 1: Tape & List Algebra Helpers @@ -24,7 +19,8 @@ variable {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] theorem pow_zero_list (u : List (Fin 2)) : u ^ (0 : Nat) = [] := rfl theorem pow_succ_list (u : List (Fin 2)) (n : Nat) : u ^ (n + 1) = u ++ u ^ n := rfl theorem nil_append_list (l : List (Fin 2)) : ([] : List (Fin 2)) ++ l = l := rfl -theorem cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : (x :: xs) ++ ys = x :: (xs ++ ys) := rfl +theorem cons_append_list (x : Fin 2) (xs ys : List (Fin 2)) : + (x :: xs) ++ ys = x :: (xs ++ ys) := rfl theorem append_nil_list (l : List (Fin 2)) : l ++ [] = l := List.append_nil l attribute [scoped simp] @@ -43,22 +39,24 @@ omit [Inhabited Γ] in theorem list_pow_add (l : List Γ) (n m : Nat) : l^(n + m) = l^n ++ l^m := BusyBeaver.list_pow_add l n m -lemma listblank_append_right_assoc (l₁ l₂ : List Γ) (s : ListBlank Γ) : +theorem listblank_append_right_assoc (l₁ l₂ : List Γ) (s : ListBlank Γ) : (l₁ ++ l₂) +> s = l₁ +> (l₂ +> s) := by induction l₁ with | nil => rfl | cons x xs ih => simp only [List.cons_append, ListBlank.append, ih] -lemma listblank_eq_one_cons_tail {Z : ListBlank (Fin 2)} (hZ : Z.head = 1) : +theorem listblank_eq_one_cons_tail {Z : ListBlank (Fin 2)} (hZ : Z.head = 1) : Z = (1 : Fin 2) >> Z.tail := by rw [← hZ, Turing.ListBlank.cons_head_tail] -@[simp] lemma zeros_append_default (n : ℕ) : +@[simp] theorem zeros_append_default (n : ℕ) : (([0] : List (Fin 2)) ^ n) +> (default : ListBlank (Fin 2)) = default := by induction n with | zero => rfl - | succ k ih => simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, ih, zero_cons_default] + | succ k ih => + simp only [pow_succ_list, cons_append_list, nil_append_list, listblank_append_cons, + ih, zero_cons_default] -- ============================================================================ -- Section 2: Universal Stack Combinators @@ -80,7 +78,8 @@ def ensureNonEmpty : List (ℕ × ℕ) → List (ℕ × ℕ) | p :: R => p :: R @[simp] theorem bumpN_zero (L : List (ℕ × ℕ)) : bumpN 0 L = L := rfl -@[simp] theorem bumpN_succ (n : ℕ) (L : List (ℕ × ℕ)) : bumpN (n + 1) L = bumpHead (bumpN n L) := rfl +@[simp] theorem bumpN_succ (n : ℕ) (L : List (ℕ × ℕ)) : + bumpN (n + 1) L = bumpHead (bumpN n L) := rfl theorem bumpHead_ne_nil (L : List (ℕ × ℕ)) : bumpHead L ≠ [] := by rcases L with _ | ⟨⟨a, b⟩, L'⟩ <;> simp [bumpHead] @@ -96,7 +95,8 @@ theorem ensureNonEmpty_ne_nil (R : List (ℕ × ℕ)) : ensureNonEmpty R ≠ [] -- ============================================================================ /-- Generic parametric left stack encoding: - `encLeft ((a, b) :: L) = encLeft L <+ (sSym ^ (sep + b % maxSep)) <+ (dSym ^ (stride * a + offset))`. -/ + `encLeft ((a, b) :: L) = + encLeft L <+ (sSym ^ (sep + b % maxSep)) <+ (dSym ^ (stride * a + offset))`. -/ def encLeftParam (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default @@ -106,7 +106,8 @@ def encLeftParam (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : (([dSym] : List (Fin 2)) ^ (stride * a + offset)) /-- Generic parametric right stack encoding: - `encRight ((d, b) :: R) = (dSym ^ (stride * d + offset)) +> ((sSym ^ (sep + b % maxSep)) +> encRight R)`. -/ + `encRight ((d, b) :: R) = + (dSym ^ (stride * d + offset)) +> ((sSym ^ (sep + b % maxSep)) +> encRight R)`. -/ def encRightParam (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) : List (ℕ × ℕ) → ListBlank (Fin 2) | [] => default @@ -219,9 +220,9 @@ theorem encRightParam_bumpN (dSym : Fin 2) (sep maxSep : ℕ) -- Section 5: Modulo & Canonical Shorthands -- ============================================================================ -lemma mod2_cases (b : ℕ) : b % 2 = 0 ∨ b % 2 = 1 := by omega -lemma mod3_cases (b : ℕ) : b % 3 = 0 ∨ b % 3 = 1 ∨ b % 3 = 2 := by omega -lemma mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega +theorem mod2_cases (b : ℕ) : b % 2 = 0 ∨ b % 2 = 1 := by omega +theorem mod3_cases (b : ℕ) : b % 3 = 0 ∨ b % 3 = 1 ∨ b % 3 = 2 := by omega +theorem mod4_cases (b : ℕ) : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega theorem encLeftParam_mod (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) (a b : ℕ) (L : List (ℕ × ℕ)) : @@ -255,7 +256,8 @@ theorem encLeftParam_norm (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) | nil => rfl | cons p L' ih => rcases p with ⟨a, b⟩ - change encLeftParam dSym sSym stride offset sep maxSep ((a, b % maxSep) :: normStack maxSep L') = + change encLeftParam dSym sSym stride offset sep maxSep + ((a, b % maxSep) :: normStack maxSep L') = encLeftParam dSym sSym stride offset sep maxSep ((a, b) :: L') simp only [encLeftParam_cons, Nat.mod_mod, ih] @@ -267,7 +269,8 @@ theorem encRightParam_norm (dSym sSym : Fin 2) (stride offset sep maxSep : ℕ) | nil => rfl | cons p R' ih => rcases p with ⟨d, b⟩ - change encRightParam dSym sSym stride offset sep maxSep ((d, b % maxSep) :: normStack maxSep R') = + change encRightParam dSym sSym stride offset sep maxSep + ((d, b % maxSep) :: normStack maxSep R') = encRightParam dSym sSym stride offset sep maxSep ((d, b) :: R') simp only [encRightParam_cons, Nat.mod_mod, ih] @@ -345,20 +348,22 @@ theorem blockEncodingParam (encLeftParam dSym sSym strideL offsetL sepL maxSepL L <+ (([sSym] : List (Fin 2)) ^ (stackSepLen sepL' maxSepL' b))) <+ (([dSym] : List (Fin 2)) ^ (strideL' * a + offsetL'))) ∧ - (∀ d (b : StackTuple 1) R, encRightParam dSym sSym strideR offsetR sepR maxSepR ((d, b) :: R) = + (∀ d (b : StackTuple 1) R, + encRightParam dSym sSym strideR offsetR sepR maxSepR ((d, b) :: R) = (([dSym] : List (Fin 2)) ^ (strideR' * d + offsetR')) +> ((([sSym] : List (Fin 2)) ^ (stackSepLen sepR' maxSepR' b)) +> encRightParam dSym sSym strideR offsetR sepR maxSepR R)) := ⟨strideL, offsetL, sepL, maxSepL, strideR, offsetR, sepR, maxSepR, h_sL, h_oL, h_sepL, h_m1L, h_m2L, h_sR, h_oR, h_sepR, h_m1R, h_m2R, - fun a b L => rfl, fun d b R => rfl⟩ + fun _ _ _ => rfl, fun _ _ _ => rfl⟩ -- ============================================================================ -- Section 9: 1-Digit Stack Lift Infrastructure -- ============================================================================ -/-- Lift a 1-digit stack `List ℕ` to a 2-digit stack `List (ℕ × ℕ)` by appending `0` second components. -/ +/-- Lift a 1-digit stack `List ℕ` to a 2-digit stack `List (ℕ × ℕ)` by appending `0` second + components. -/ def liftPairList : List ℕ → List (ℕ × ℕ) | [] => [] | x :: xs => (x, 0) :: liftPairList xs @@ -403,13 +408,16 @@ theorem lift_one_digit_prop {Λ : Type*} [Inhabited Λ] (encLeft1 encRight1 : List ℕ → ListBlank (Fin 2)) (evalStackCfg1 : StackMode → List ℕ → List ℕ → Cfg (Fin 2) Λ) (IsInStackSystem1 : Cfg (Fin 2) Λ → Prop) - (h : OneDigitStackCryptidProp target_tm StackMode encLeft1 encRight1 evalStackCfg1 IsInStackSystem1) : + (h : OneDigitStackCryptidProp target_tm StackMode encLeft1 encRight1 + evalStackCfg1 IsInStackSystem1) : IsStackCryptid target_tm := by refine ⟨StackMode, 1, 0, fun (L : List (ℕ × ℕ)) => encLeft1 (L.map Prod.fst), fun (R : List (ℕ × ℕ)) => encRight1 (R.map Prod.fst), - fun (m : StackMode) (L R : List (ℕ × ℕ)) => evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), - fun (cfg : Cfg (Fin 2) Λ) => ∃ (m : StackMode) (L R : List (ℕ × ℕ)), cfg = evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), + fun (m : StackMode) (L R : List (ℕ × ℕ)) => + evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), + fun (cfg : Cfg (Fin 2) Λ) => ∃ (m : StackMode) (L R : List (ℕ × ℕ)), + cfg = evalStackCfg1 m (L.map Prod.fst) (R.map Prod.fst), ?_⟩ rcases h with ⟨hnilL, hnilR, hheadL, hheadR, ⟨tL, htL, hnsL⟩, ⟨tR, htR, hnsR⟩, ⟨sL, oL, sepL, sR, oR, sepR, hsL, hoL, hsepL, hsR, hoR, hsepR, hblkL, hblkR⟩, diff --git a/BusyBeaver/WordRunStack.lean b/BusyBeaver/WordRunStack.lean index d911be0b..c212bff0 100644 --- a/BusyBeaver/WordRunStack.lean +++ b/BusyBeaver/WordRunStack.lean @@ -17,11 +17,6 @@ open Mathlib Relation Nat Turing BusyBeaver namespace BusyBeaver.WordRunStack -set_option linter.style.longLine false -set_option linter.style.setOption false -set_option linter.unusedVariables false -set_option linter.unusedSimpArgs false - variable {Γ : Type*} [Inhabited Γ] theorem append_assoc_blank (u v : List Γ) (lb : ListBlank Γ) : diff --git a/BusyBeaverChallenge.lean b/BusyBeaverChallenge.lean index 31cb1330..dce54077 100644 --- a/BusyBeaverChallenge.lean +++ b/BusyBeaverChallenge.lean @@ -960,11 +960,22 @@ def regsBitLenAux {Γ : Type*} : (m : ℕ) → (Fin m → List Γ) → (Fin m | m + 1, rw, r => (rw 0).length * r 0 + regsBitLenAux m (fun i => rw i.succ) (fun i => r i.succ) section -universe u +universe u v /-- Prefix length of a `HalfTapeView`. -/ def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := - v.casesOn (fun p => p.length) (fun p => p.length) + HalfTapeView.casesOn (motive := fun _ => ℕ) v List.length List.length + +/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the + valid states): every finite window of every valid half-tape extends to a half-tape that no + valid state encodes, i.e. the image has empty interior in the prefix topology. A + bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family + certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ +def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] + (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := + ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, + (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad + end /-- Full symbolic state of a two-sided word-run stack + accumulator system. -/ @@ -1154,10 +1165,8 @@ def IsWordRunCryptid {k : ℕ} {Λ : Type*} [Inhabited Λ] (∀ s, ValidState s → MergedRunFrames specL s.L ∧ MergedRunFrames specR s.R ∧ AnchoredFrames specL s.L ∧ AnchoredFrames specR s.R) ∧ - ((∃ badL : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specL s.regsL s.L ≠ badL) ∨ - IsBoundaryAlignedSide .leftSide specL specR ValidState evalCfg) ∧ - ((∃ badR : ListBlank (Fin (k + 2)), ∀ s, ValidState s → encHalf specR s.regsR s.R ≠ badR) ∨ - IsBoundaryAlignedSide .rightSide specL specR ValidState evalCfg) ∧ + IsNowhereDenseFamily ValidState (fun s => encHalf specL s.regsL s.L) ∧ + IsNowhereDenseFamily ValidState (fun s => encHalf specR s.regsR s.R) ∧ (∀ s s', ValidState s → stepMacro s = some s' → ValidState s' ∧ ∃ n, StrictFrameProgress specL specR s s' n ∧ ReachesIn M n (evalCfg s) (evalCfg s')) ∧ @@ -1246,59 +1255,73 @@ def evalSegmentedHalf {Γ : Type u} [Inhabited Γ] : List (SegRegionKind Γ) → | [] => default | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) -/-- Prefix-extensible non-surjectivity of a family of half-tapes `enc s` (`s` ranging over the - valid states): every finite window of every valid half-tape extends to a half-tape that no - valid state encodes, i.e. the image has empty interior in the prefix topology. A - bounded-prefix restriction such as "the head cell is `0`" never satisfies it, so a family - certified by it carries a genuine unbounded grammar rather than a renaming of the raw tape. -/ -def IsNowhereDenseFamily {Γ : Type u} {S : Type v} [Inhabited Γ] - (Valid : S → Prop) (enc : S → ListBlank Γ) : Prop := - ∀ s, Valid s → ∀ n : ℕ, ∃ bad : ListBlank Γ, - (∀ i, i < n → bad.nth i = (enc s).nth i) ∧ ∀ s', Valid s' → enc s' ≠ bad +/-- Structural well-formedness for a `SegRegionKind`: non-empty periodic/word blocks, bounded + `.gadget` literals (`w.length ≤ 16`), and no full single-symbol raw alphabet wrapping inside + `.wordRun` / `.finWord`. -/ +def SegRegionKind.WellFormed {Γ : Type u} : SegRegionKind Γ → Prop + | .reg blk _ => blk ≠ [] + | .wordRun frames => + (∀ p ∈ frames, p.1 ≠ []) ∧ ¬ ∀ b : Γ, ∃ p ∈ frames, p.1 = [b] + | .finWord words => + (∀ w ∈ words, w ≠ []) ∧ ¬ ∀ b : Γ, [b] ∈ words + | .gadget w => w.length ≤ 16 /-- `IsNowhereDenseFamily` for the evaluated segmented half-tapes `evalSegmentedHalf (segs s)`. -/ def IsNowhereDenseHalf {Γ : Type u} {S : Type v} [Inhabited Γ] (Valid : S → Prop) (segs : S → List (SegRegionKind Γ)) : Prop := IsNowhereDenseFamily Valid (fun s => evalSegmentedHalf (segs s)) +/-- Closed `≤ 3`-region segmented transition system on an explicit `(SegState, Mode)` carrier. -/ +def IsClosedSegmentedSystem {k : ℕ} {Λ : Type u} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) + {SegState Mode : Type} + (modes : List Mode) + (ValidSeg : SegState → Prop) + (modeOf : SegState → Mode) + (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) + (evalCfg : SegState → Cfg (Fin (k + 2)) Λ) : Prop := + 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ (∀ m : Mode, m ∈ modes) ∧ + (∀ s, ValidSeg s → + (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3 ∧ + (∀ r ∈ segsL s, r.WellFormed) ∧ (∀ r ∈ segsR s, r.WellFormed)) ∧ + (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), + viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ + ∀ s, ValidSeg s → modeOf s = m → + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), + applyView vL (evalSegmentedHalf (segsL s)), + applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s)))) ∨ + (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) + (applyView vR (evalSegmentedHalf (segsR s))))) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ + (IsNowhereDenseHalf ValidSeg segsL ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ + (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ + (IsNowhereDenseHalf ValidSeg segsR ∨ + (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), + (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ + (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ + (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ + (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ + (∀ s, ValidSeg s → + ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ + ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + /-- Unifying `≤ 3`-Region Segmented Schema (`IsSegmentedCryptid`). At least one half-tape must be `IsNowhereDenseHalf`; a half-tape that is not must be boundary-aligned (no hidden view - prefix). -/ + prefix), and all regions must be `SegRegionKind.WellFormed`. -/ def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] (M : Machine (Fin (k + 2)) Λ) : Prop := - ∃ (SegState : Type) - (Mode : Type) + ∃ (SegState Mode : Type) + (modes : List Mode) (ValidSeg : SegState → Prop) (modeOf : SegState → Mode) (segsL segsR : SegState → List (SegRegionKind (Fin (k + 2)))) (evalCfg : SegState → Cfg (Fin (k + 2)) Λ), - (∃ modes : List Mode, 1 ≤ modes.length ∧ modes.length ≤ 8 ∧ ∀ m : Mode, m ∈ modes) ∧ - (∀ s, ValidSeg s → (segsL s).length ≤ 3 ∧ (segsR s).length ≤ 3) ∧ - (∀ m : Mode, ∃ (q : Λ) (vL vR : HalfTapeView (Fin (k + 2))), - viewPrefixLen vL ≤ 8 ∧ viewPrefixLen vR ≤ 8 ∧ - ∀ s, ValidSeg s → modeOf s = m → - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), - applyView vL (evalSegmentedHalf (segsL s)), - applyView vR (evalSegmentedHalf (segsR s))⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q (applyView vL (evalSegmentedHalf (segsL s))) - (applyView vR (evalSegmentedHalf (segsR s)))) ∨ - (evalCfg s = Cfg.headRight q (applyView vL (evalSegmentedHalf (segsL s))) - (applyView vR (evalSegmentedHalf (segsR s))))) ∧ - (IsNowhereDenseHalf ValidSeg segsL ∨ IsNowhereDenseHalf ValidSeg segsR) ∧ - (IsNowhereDenseHalf ValidSeg segsL ∨ - (∀ s, ValidSeg s → ∃ (q : Λ) (vR : ListBlank (Fin (k + 2))), - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), evalSegmentedHalf (segsL s), vR⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q (evalSegmentedHalf (segsL s)) vR) ∨ - (evalCfg s = Cfg.headRight q (evalSegmentedHalf (segsL s)) vR))) ∧ - (IsNowhereDenseHalf ValidSeg segsR ∨ - (∀ s, ValidSeg s → ∃ (q : Λ) (vL : ListBlank (Fin (k + 2))), - (evalCfg s = ⟨some q, ⟨(0 : Fin (k + 2)), vL, evalSegmentedHalf (segsR s)⟩⟩) ∨ - (evalCfg s = Cfg.headLeft q vL (evalSegmentedHalf (segsR s))) ∨ - (evalCfg s = Cfg.headRight q vL (evalSegmentedHalf (segsR s))))) ∧ - (∃ s₀, ValidSeg s₀ ∧ ReachesPlus M (init []) (evalCfg s₀)) ∧ - (∀ s, ValidSeg s → - ∃ cfg', ReachesPlus M (evalCfg s) cfg' ∧ - ((∃ s', ValidSeg s' ∧ cfg' = evalCfg s') ∨ (step M cfg').isNone)) + IsClosedSegmentedSystem M modes ValidSeg modeOf segsL segsR evalCfg namespace SixState @@ -9901,461 +9924,921 @@ end BusyBeaver.M_1RBHHH_1RC1RE_1LD0RC_0RE0LD_1LC0LF_1RA0RF namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH open Turing BusyBeaver -/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 0, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.right) - | 1, 1 => some (some 1, Stmt.write 0 Dir.right) - | 2, 0 => some (some 3, Stmt.write 1 Dir.left) - | 2, 1 => some (some 0, Stmt.write 1 Dir.left) - | 3, 0 => some (some 2, Stmt.write 1 Dir.left) - | 3, 1 => some (some 4, Stmt.write 1 Dir.right) - | 4, 0 => some (some 5, Stmt.write 1 Dir.right) - | 4, 1 => some (some 3, Stmt.write 0 Dir.right) - | 5, 0 => some (some 0, Stmt.write 1 Dir.left) - | 5, 1 => none - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---" + +/-- `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{0}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH namespace BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH open Turing BusyBeaver -/-- Transition function for `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 0, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.right) - | 1, 1 => some (some 1, Stmt.write 0 Dir.right) - | 2, 0 => some (some 3, Stmt.write 1 Dir.left) - | 2, 1 => some (some 0, Stmt.write 1 Dir.left) - | 3, 0 => some (some 2, Stmt.write 1 Dir.left) - | 3, 1 => some (some 4, Stmt.write 1 Dir.right) - | 4, 0 => some (some 5, Stmt.write 1 Dir.right) - | 4, 1 => some (some 3, Stmt.write 0 Dir.right) - | 5, 0 => some (some 2, Stmt.write 1 Dir.left) - | 5, 1 => none - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---" + +/-- `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{0}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH open Turing BusyBeaver -/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 3, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 1 Dir.left) - | 2, 1 => some (some 3, Stmt.write 0 Dir.right) - | 3, 0 => some (some 1, Stmt.write 0 Dir.right) - | 3, 1 => some (some 3, Stmt.write 0 Dir.left) - | 4, 0 => some (some 2, Stmt.write 1 Dir.right) - | 4, 1 => some (some 5, Stmt.write 1 Dir.right) - | 5, 0 => some (some 0, Stmt.write 1 Dir.right) - | 5, 1 => none - -theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by sorry +/-- `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---" + +/-- `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_odometer_cryptid : IsOdometerCryptid target := by sorry end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH namespace BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH open Turing BusyBeaver -/-- Transition function for `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 3, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 1 Dir.left) - | 2, 1 => some (some 3, Stmt.write 0 Dir.right) - | 3, 0 => some (some 1, Stmt.write 0 Dir.right) - | 3, 1 => some (some 5, Stmt.write 0 Dir.left) - | 4, 0 => some (some 2, Stmt.write 1 Dir.right) - | 4, 1 => some (some 0, Stmt.write 1 Dir.left) - | 5, 0 => some (some 1, Stmt.write 0 Dir.right) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---" + +/-- `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH namespace BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH open Turing BusyBeaver -/-- Transition function for `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 3, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.right) - | 1, 1 => some (some 3, Stmt.write 1 Dir.right) - | 2, 0 => some (some 0, Stmt.write 1 Dir.left) - | 2, 1 => some (some 0, Stmt.write 1 Dir.right) - | 3, 0 => some (some 4, Stmt.write 1 Dir.left) - | 3, 1 => some (some 4, Stmt.write 0 Dir.left) - | 4, 0 => some (some 5, Stmt.write 1 Dir.right) - | 4, 1 => some (some 0, Stmt.write 0 Dir.left) - | 5, 0 => some (some 0, Stmt.write 0 Dir.right) - | 5, 1 => none - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---" + +/-- `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAR + | mA0R + | mEL +deriving DecidableEq, Repr + +def onesSep0 (d : ℕ) : List (Fin 2) := + Nat.rec [0] (fun _ acc => 1 :: acc) d + +def lWord (d : ℕ) : List (Fin 2) := 1 :: onesSep0 d + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun d _ acc => lWord d +> acc) S + +def rWord (z : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) z + +def encRight (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun z _ acc => rWord z +> acc) S + +abbrev SegState := SegMode × List ℕ × List ℕ + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAR, .mA0R, .mEL] + +def evalSegCfg : SegMode → List ℕ → List ℕ → Cfg (Fin 2) (Fin 6) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mA0R, L, R => (applyView (.id [0]) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mEL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id []) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 0 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 0, Stmt.write 0 Dir.right) - | 5, 0 => some (some 4, Stmt.write 0 Dir.right) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 0, Stmt.write 0 Dir.right) - | 5, 0 => some (some 1, Stmt.write 0 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 0, Stmt.write 0 Dir.right) - | 5, 0 => some (some 4, Stmt.write 0 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 4, Stmt.write 0 Dir.right) - | 5, 0 => some (some 0, Stmt.write 0 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 4, Stmt.write 0 Dir.right) - | 5, 0 => some (some 2, Stmt.write 0 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 4, Stmt.write 0 Dir.right) - | 5, 0 => some (some 0, Stmt.write 1 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH namespace BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH open Turing BusyBeaver -/-- Transition function for `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.left) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 0, Stmt.write 0 Dir.right) - | 2, 1 => some (some 3, Stmt.write 0 Dir.left) - | 3, 0 => some (some 0, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.left) - | 4, 1 => some (some 4, Stmt.write 0 Dir.right) - | 5, 0 => some (some 4, Stmt.write 1 Dir.left) - | 5, 1 => none - -theorem is_stack_cryptid : IsStackCryptid target_tm := by sorry +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---" + +/-- `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_stack_cryptid : IsStackCryptid target := by sorry end BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH namespace BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE open Turing BusyBeaver -/-- Transition function for `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 0, Stmt.write 0 Dir.right) - | 1, 0 => some (some 2, Stmt.write 0 Dir.left) - | 1, 1 => some (some 4, Stmt.write 0 Dir.right) - | 2, 0 => some (some 4, Stmt.write 1 Dir.left) - | 2, 1 => some (some 3, Stmt.write 1 Dir.left) - | 3, 0 => some (some 4, Stmt.write 0 Dir.left) - | 3, 1 => none - | 4, 0 => some (some 5, Stmt.write 1 Dir.left) - | 4, 1 => some (some 2, Stmt.write 0 Dir.left) - | 5, 0 => some (some 0, Stmt.write 1 Dir.right) - | 5, 1 => some (some 4, Stmt.write 1 Dir.left) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE" + +/-- `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def encLeft (S : List (ℕ × Bool)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => lWord p +> acc) S + +def encRight (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun z _ acc => zWord z +> acc) S + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +def modes : List SegMode := [.mCL, .mAR, .mA0] + +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encRight R)) {{0}}> (applyView (.id []) (encLeft L)) + | .mAR, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id []) (encLeft L)) + | .mA0, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id [0]) (encLeft L)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE namespace BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH open Turing BusyBeaver -/-- Transition function for `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.right) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 0, Stmt.write 1 Dir.right) - | 2, 0 => some (some 3, Stmt.write 1 Dir.left) - | 2, 1 => some (some 2, Stmt.write 0 Dir.left) - | 3, 0 => some (some 4, Stmt.write 0 Dir.right) - | 3, 1 => some (some 0, Stmt.write 0 Dir.left) - | 4, 0 => some (some 0, Stmt.write 1 Dir.right) - | 4, 1 => some (some 5, Stmt.write 1 Dir.right) - | 5, 0 => some (some 0, Stmt.write 0 Dir.right) - | 5, 1 => none - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---" + +/-- `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def encLeft (S : List (ℕ × Bool)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => lWord p +> acc) S + +def encRight (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun z _ acc => zWord z +> acc) S + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +def modes : List SegMode := [.mCL, .mAR, .mA0] + +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id []) (encRight R)) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + | .mA0, L, R => (applyView (.id [0]) (encLeft L)) {{0}}> (applyView (.id []) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH namespace BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF open Turing BusyBeaver -/-- Transition function for `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 0 Dir.right) - | 1, 0 => some (some 2, Stmt.write 1 Dir.right) - | 1, 1 => none - | 2, 0 => some (some 3, Stmt.write 0 Dir.right) - | 2, 1 => some (some 2, Stmt.write 0 Dir.right) - | 3, 0 => some (some 4, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.left) - | 4, 0 => some (some 3, Stmt.write 1 Dir.left) - | 4, 1 => some (some 0, Stmt.write 1 Dir.right) - | 5, 0 => some (some 2, Stmt.write 1 Dir.right) - | 5, 1 => some (some 5, Stmt.write 0 Dir.left) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF" + +/-- `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{5}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{2}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{4}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{4}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF namespace BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA open Turing BusyBeaver -/-- Transition function for `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 5, Stmt.write 0 Dir.right) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => none - | 2, 0 => some (some 5, Stmt.write 1 Dir.left) - | 2, 1 => some (some 3, Stmt.write 1 Dir.left) - | 3, 0 => some (some 4, Stmt.write 1 Dir.right) - | 3, 1 => some (some 3, Stmt.write 0 Dir.left) - | 4, 0 => some (some 2, Stmt.write 0 Dir.right) - | 4, 1 => some (some 4, Stmt.write 0 Dir.right) - | 5, 0 => some (some 2, Stmt.write 1 Dir.left) - | 5, 1 => some (some 0, Stmt.write 1 Dir.right) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA" + +/-- `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{4}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft L)) {{5}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft L)) {{5}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA namespace BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA open Turing BusyBeaver -/-- Transition function for `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 5, Stmt.write 0 Dir.right) - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => none - | 2, 0 => some (some 3, Stmt.write 1 Dir.right) - | 2, 1 => some (some 2, Stmt.write 0 Dir.left) - | 3, 0 => some (some 4, Stmt.write 0 Dir.right) - | 3, 1 => some (some 3, Stmt.write 0 Dir.right) - | 4, 0 => some (some 5, Stmt.write 1 Dir.left) - | 4, 1 => some (some 2, Stmt.write 1 Dir.left) - | 5, 0 => some (some 4, Stmt.write 1 Dir.left) - | 5, 1 => some (some 0, Stmt.write 1 Dir.right) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA" + +/-- `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{3}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{5}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{5}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA namespace BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH open Turing BusyBeaver -/-- Transition function for `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 5, Stmt.write 1 Dir.right) - | 1, 0 => some (some 2, Stmt.write 1 Dir.right) - | 1, 1 => some (some 0, Stmt.write 0 Dir.right) - | 2, 0 => some (some 3, Stmt.write 1 Dir.left) - | 2, 1 => some (some 1, Stmt.write 1 Dir.right) - | 3, 0 => some (some 4, Stmt.write 1 Dir.left) - | 3, 1 => some (some 3, Stmt.write 0 Dir.left) - | 4, 0 => some (some 0, Stmt.write 0 Dir.right) - | 4, 1 => some (some 1, Stmt.write 0 Dir.left) - | 5, 0 => some (some 1, Stmt.write 0 Dir.right) - | 5, 1 => none - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---" + +/-- `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mCL + | mAR + | mA0 +deriving DecidableEq, Repr + +def lWord (p : ℕ × Bool) : List (Fin 2) := + Bool.casesOn p.2 + (Nat.rec [1, 0] (fun _ acc => 1 :: acc) p.1) + (Nat.rec [1, 0, 0] (fun _ acc => 1 :: 1 :: acc) p.1) + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def encLeft (S : List (ℕ × Bool)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => lWord p +> acc) S + +def encRight (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun z _ acc => zWord z +> acc) S + +abbrev SegState := SegMode × List (ℕ × Bool) × List ℕ + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.1.map lWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map zWord)] + +def modes : List SegMode := [.mCL, .mAR, .mA0] + +def evalSegCfg : SegMode → List (ℕ × Bool) → List ℕ → Cfg (Fin 2) (Fin 6) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{3}} (applyView (.id []) (encRight R)) + | .mAR, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mA0, L, R => (applyView (.id [0]) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH namespace BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD open Turing BusyBeaver -/-- Transition function for `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => none - | 1, 0 => some (some 2, Stmt.write 0 Dir.right) - | 1, 1 => some (some 1, Stmt.write 0 Dir.right) - | 2, 0 => some (some 3, Stmt.write 1 Dir.left) - | 2, 1 => some (some 4, Stmt.write 1 Dir.left) - | 3, 0 => some (some 2, Stmt.write 1 Dir.left) - | 3, 1 => some (some 5, Stmt.write 1 Dir.right) - | 4, 0 => some (some 1, Stmt.write 1 Dir.right) - | 4, 1 => some (some 4, Stmt.write 0 Dir.left) - | 5, 0 => some (some 0, Stmt.write 1 Dir.right) - | 5, 1 => some (some 3, Stmt.write 0 Dir.right) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD" + +/-- `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encLeft L)) <{{4}} (applyView (.id []) (encRight R)) + | .mB0, L, R => (applyView (.id []) (encLeft L)) {{1}}> (applyView (.id []) (encRight R)) + | .mD0, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id []) (encRight R)) + | .mD1, L, R => (applyView (.id []) (encLeft (1 :: L))) {{3}}> (applyView (.id [1]) (encRight R)) + | .mCL, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1, 1]) (encRight R)) + | .mCL1, L, R => (applyView (.id []) (encLeft L)) <{{2}} (applyView (.id [1]) (encRight R)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD namespace BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE open Turing BusyBeaver -/-- Transition function for `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => none - | 1, 0 => some (some 2, Stmt.write 1 Dir.left) - | 1, 1 => some (some 1, Stmt.write 0 Dir.right) - | 2, 0 => some (some 3, Stmt.write 0 Dir.left) - | 2, 1 => some (some 2, Stmt.write 0 Dir.left) - | 3, 0 => some (some 4, Stmt.write 1 Dir.right) - | 3, 1 => some (some 1, Stmt.write 1 Dir.right) - | 4, 0 => some (some 3, Stmt.write 1 Dir.right) - | 4, 1 => some (some 5, Stmt.write 1 Dir.left) - | 5, 0 => some (some 0, Stmt.write 1 Dir.left) - | 5, 1 => some (some 4, Stmt.write 0 Dir.left) - -theorem is_segmented_cryptid : IsSegmentedCryptid target_tm := by sorry +/-- `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE" + +/-- `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +inductive SegMode where + | mAL + | mB0 + | mD0 + | mD1 + | mCL + | mCL1 +deriving DecidableEq, Repr + +def zWord (k : ℕ) : List (Fin 2) := + Nat.rec [1] (fun _ acc => 0 :: acc) k + +def oRun (o : ℕ) : List (Fin 2) := + Nat.rec [1, 1] (fun _ acc => 1 :: acc) o + +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +def encLeft (S : List ℕ) : ListBlank (Fin 2) := + List.rec default (fun k _ acc => zWord k +> acc) S + +def encRight (S : List (ℕ × ℕ)) : ListBlank (Fin 2) := + List.rec default (fun p _ acc => rWord p +> acc) S + +abbrev SegState := SegMode × List ℕ × List (ℕ × ℕ) + +def modeOf (s : SegState) : SegMode := s.1 + +def ValidSeg (_ : SegState) : Prop := True + +def leftList : SegMode → List ℕ → List ℕ + | .mD0, L => 1 :: L + | .mD1, L => 1 :: L + | _, L => L + +def segsL (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord (s.2.2.map rWord)] + +def segsR (s : SegState) : List (SegRegionKind (Fin 2)) := + [.finWord ((leftList s.1 s.2.1).map zWord)] + +def modes : List SegMode := [.mAL, .mB0, .mD0, .mD1, .mCL, .mCL1] + +def evalSegCfg : SegMode → List ℕ → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .mAL, L, R => (applyView (.id []) (encRight R)) {{1}}> (applyView (.id []) (encLeft L)) + | .mB0, L, R => (applyView (.id []) (encRight R)) <{{2}} (applyView (.id []) (encLeft L)) + | .mD0, L, R => (applyView (.id []) (encRight R)) <{{4}} (applyView (.id []) (encLeft (1 :: L))) + | .mD1, L, R => (applyView (.id [1]) (encRight R)) <{{4}} (applyView (.id []) (encLeft (1 :: L))) + | .mCL, L, R => (applyView (.id [1, 1]) (encRight R)) {{3}}> (applyView (.id []) (encLeft L)) + | .mCL1, L, R => (applyView (.id [1]) (encRight R)) {{3}}> (applyView (.id []) (encLeft L)) + +def evalCfg (s : SegState) : Cfg (Fin 2) (Fin 6) := + evalSegCfg s.1 s.2.1 s.2.2 + +theorem is_closed_segmented_system : + IsClosedSegmentedSystem target modes ValidSeg modeOf segsL segsR evalCfg := by + sorry +theorem is_segmented_cryptid : IsSegmentedCryptid target := by sorry end BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE namespace BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA open Turing BusyBeaver -/-- Transition function for `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => none - | 1, 0 => some (some 2, Stmt.write 1 Dir.right) - | 1, 1 => some (some 4, Stmt.write 0 Dir.left) - | 2, 0 => some (some 3, Stmt.write 0 Dir.left) - | 2, 1 => some (some 5, Stmt.write 0 Dir.right) - | 3, 0 => some (some 1, Stmt.write 1 Dir.left) - | 3, 1 => some (some 4, Stmt.write 0 Dir.right) - | 4, 0 => some (some 2, Stmt.write 0 Dir.right) - | 4, 1 => some (some 4, Stmt.write 0 Dir.left) - | 5, 0 => some (some 3, Stmt.write 1 Dir.right) - | 5, 1 => some (some 0, Stmt.write 1 Dir.right) - -theorem is_odometer_cryptid : IsOdometerCryptid target_tm := by sorry +/-- `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA" + +/-- `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +theorem is_odometer_cryptid : IsOdometerCryptid target := by sorry end BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA namespace BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE -open Turing BusyBeaver +open SixState Turing BusyBeaver -/-- Transition function for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ -def target_tm : Machine (Fin 2) (Fin 6) - | 0, 0 => some (some 1, Stmt.write 1 Dir.right) - | 0, 1 => some (some 4, Stmt.write 1 Dir.left) - | 1, 0 => some (some 2, Stmt.write 0 Dir.left) - | 1, 1 => some (some 1, Stmt.write 0 Dir.left) - | 2, 0 => some (some 3, Stmt.write 1 Dir.right) - | 2, 1 => some (some 2, Stmt.write 1 Dir.left) - | 3, 0 => some (some 3, Stmt.write 1 Dir.right) - | 3, 1 => some (some 0, Stmt.write 1 Dir.right) - | 4, 0 => some (some 5, Stmt.write 1 Dir.right) - | 4, 1 => some (some 0, Stmt.write 0 Dir.left) - | 5, 0 => none - | 5, 1 => some (some 4, Stmt.write 1 Dir.right) - -theorem is_cryptid : IsCryptid target_tm := by sorry +/-- `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` as a `ConjectureMachines.Machine`. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE" + +/-- `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` as a `BusyBeaver.Machine`. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +def pat_A : TapePattern (Fin 2) (Fin 6) := + { left := .rep [1] 0 .default + head := some A + right := .rep [1, 0] 1 (.sym 1 (.rep [1] 2 .default)) } + +def pat_Run : TapePattern (Fin 2) (Fin 6) := + { left := .rep [1] 0 .default + head := some D + right := .default } + +def ps : TapePatternSet (Fin 2) (Fin 6) := + [(pat_A, .true), (pat_Run, .true)] + +inductive State where + | A (a c d : ℕ) + | Run (a : ℕ) + deriving DecidableEq, Repr + +def start : State := .A 2 0 1 + +def encode : State → Cfg (Fin 2) (Fin 6) + | .A a c d => + Cfg.headRight A (([1] : List (Fin 2)) ^ a +> default) + (([1, 0] : List (Fin 2)) ^ c +> + ((1 : Fin 2) >> (([1] : List (Fin 2)) ^ d +> default))) + | .Run a => + Cfg.headRight D (([1] : List (Fin 2)) ^ a +> default) default + +def next : State → Option State + | .Run a => some (.Run (a + 1)) + | .A (a + 2) c d => some (.A a (c + 1) d) + | .A 0 _ 0 => none + | .A 0 c 1 => some (.A (2 * c + 1) 0 0) + | .A 0 c (d + 2) => some (.A (2 * c + 1) 1 d) + | .A 1 c 0 => + if c % 2 = 0 then some (.Run 1) else some (.A 2 0 (3 * c + 4)) + | .A 1 c 1 => + if c % 2 = 0 then some (.A 2 0 (3 * c + 6)) else some (.A (3 * c + 5) 0 0) + | .A 1 c (d + 2) => + if c % 2 = 0 then some (.A (3 * c + 7) 0 d) else some (.A (3 * c + 5) 0 (d + 1)) + +theorem is_closed_pattern_set : IsClosedPatternSet target ps := by sorry +theorem has_collatz_reduction : HasCollatzReduction target := by sorry +theorem is_valid_acceleration : IsValidAcceleration target start encode next := by sorry +theorem isHalt_iff_acceleration : IsHalt target ↔ CollatzHalts next start := by sorry +theorem is_cryptid : IsCryptid target := by sorry end BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE diff --git a/CORE_MANIFEST.json b/CORE_MANIFEST.json index c17b5bff..71f7c580 100644 --- a/CORE_MANIFEST.json +++ b/CORE_MANIFEST.json @@ -7,8 +7,8 @@ "BusyBeaver/Defs/Stack.lean": "c72377cfde8df4bf3634467bbfa5ead837f818beff11a78540fc19b3c5f16b2b", "BusyBeaver/Defs/Odometer.lean": "447c59d8748a6913f6c345e238fac56975092075c0c4bcd8ee8aea6cab36f4e4", "BusyBeaver/Defs/Transducer.lean": "12cd7052d69b41417bad77228111411b98c3dd6ec513ae7b6440eb7c23831e9f", - "BusyBeaver/Defs/WordRun.lean": "865bd40c12c48e11d16585acd687f95d7357d19e920a87c4ff26fe176ca77003", - "BusyBeaver/Defs/Segmented.lean": "335324f4070e9d53da4505cc760aa8ab5f27722af7167048b624ed6f1f128ef0", + "BusyBeaver/Defs/WordRun.lean": "4eb9a109d509ed5af3311806ac9807e3cb3bded4462d10de2ade20272c91d5b9", + "BusyBeaver/Defs/Segmented.lean": "40f9ba866be37c7b373f4d06ebdf5cab03638181ddb8b2de52801f4a8034be84", "BusyBeaver/Basic.lean": "35cf96b7db7ce0dbd629af00540121d4f64eb18755774356a4309eee9a6a0c4e", "BusyBeaver/WordRLE.lean": "b819bc8e072a8b2274f60c3cae72f61dbb9057ef9481facbc68801dd4b2ce803", "BusyBeaver/AffRLE.lean": "8434da7a25f766df93481813f0b17286337df21f35ed55f43845ca93b6903e95", diff --git a/README.md b/README.md index 8430e160..56f1b2db 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for | Library | Scope | Key Results | Documentation | | :--- | :--- | :--- | :--- | | [`Cryptids/`](Cryptids/) | `(Q, 2)` Turing machines for Goldbach, ZF consistency, the Riemann Hypothesis, Erdős's ternary conjecture, and Brocard's problem | Certified state reductions (`25 → 21`, `393 → 380`, `120 → 104 → 95`, `15 → 14`), a new 28-state Brocard machine, and end-to-end halting equivalences (`Halts M ↔ ¬ GoldbachConjecture`, `ZFInconsistent`, `¬ RiemannHypothesis`, `¬ ErdosTernaryConjecture`, `¬ BrocardConjecture`) | [`Cryptids/README.md`](Cryptids/README.md), [`Cryptids/Semantics/README.md`](Cryptids/Semantics/README.md) | -| [`BusyBeaver/`](BusyBeaver/) | `BB(6)` `(6, 2)` and `BB(3, 3)` `(3, 3)` holdout Turing machines (some are potential Cryptids, subject to community acceptance) | Shared execution semantics (`BusyBeaver/Defs.lean`), foundational lemmas (`BusyBeaver/Basic.lean`), RLE loader and `ConjectureMachines` bridge (`BusyBeaver/Bridge.lean`), and certified behavioral proofs in [`BusyBeaver/BB6/`](BusyBeaver/BB6/README.md) (54 closed-pattern/reflective holdouts + 35 [`Accelerations/`](BusyBeaver/BB6/Accelerations/README.md) + 180 resolved [`Halt/`](BusyBeaver/BB6/Halt/) and [`NonHalt/`](BusyBeaver/BB6/NonHalt/) proofs, plus halting equivalences and hardness evidence) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/README.md), [`BusyBeaver/BB6/Accelerations/README.md`](BusyBeaver/BB6/Accelerations/README.md), [`BusyBeaver/BB33/README.md`](BusyBeaver/BB33/README.md) | +| [`BusyBeaver/`](BusyBeaver/) | `BB(6)` `(6, 2)` and `BB(3, 3)` `(3, 3)` holdout Turing machines (some are potential Cryptids, subject to community acceptance) | Shared execution semantics (`BusyBeaver/Defs.lean`), foundational lemmas (`BusyBeaver/Basic.lean`), RLE loader and `ConjectureMachines` bridge (`BusyBeaver/Bridge.lean`), and certified behavioral proofs in [`BusyBeaver/BB6/`](BusyBeaver/BB6/README.md) (55 closed-pattern/reflective holdouts + 56 [`Accelerations/`](BusyBeaver/BB6/Accelerations/README.md) + 191 resolved [`Halt/`](BusyBeaver/BB6/Halt/) and [`NonHalt/`](BusyBeaver/BB6/NonHalt/) proofs, plus halting equivalences and hardness evidence) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/README.md), [`BusyBeaver/BB6/Accelerations/README.md`](BusyBeaver/BB6/Accelerations/README.md), [`BusyBeaver/BB33/README.md`](BusyBeaver/BB33/README.md) | All Lean 4 proofs are checked by the kernel without `sorry` and depend only on standard Lean axioms: - **Constructive (`["propext", "Quot.sound"]`, no `Classical.choice`):** All ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, `halts_zf432_iff_wadeZFInconsistent`), first-order Peano Arithmetic (`PAProvable`) consistency and $\Sigma_1^0$ standard-model adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent` in [`Cryptids/Semantics/PA/`](Cryptids/Semantics/PA/)), the direct simulation state reductions ([`Goldbach21.lean`](Cryptids/Goldbach21.lean), [`Zf380.lean`](Cryptids/Zf380.lean), [`Riemann104.lean`](Cryptids/Riemann104.lean)), the `erdos_ternary_14` reduction ([`ErdosTernary14.lean`](Cryptids/ErdosTernary14.lean)), the `brocard_28` equivalence `Halts brocard28 ↔ ∃ n, 7 < n ∧ IsSquare (n! + 1)` ([`Brocard28.lean`](Cryptids/Brocard28.lean), [`Semantics/Brocard28.lean`](Cryptids/Semantics/Brocard28.lean)), and all five `candidate_fewer_states` theorems, audited in CI via [`comparator/constructive.json`](comparator/constructive.json). Because classical Lean (`ZFSet.{0}` in [`Soundness.lean`](Cryptids/Semantics/Zf/Soundness.lean)) proves `¬ ZFInconsistent`—so any non-halting machine would vacuously satisfy `Halts M ↔ ZFInconsistent` under `Classical.choice`—excluding `Classical.choice` blocks classical `Con(ZF)` shortcuts, while deeply embedded `PAProvable` provides a weak first-order metatheory strictly below `ZF` (see [Foundational Note on `Con(ZF)` and Constructive Equivalence](Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). diff --git a/comparator/README.md b/comparator/README.md index e8917149..046e2d76 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -20,14 +20,14 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). acceleration semantics (`IsClosedPatternSet`, `HasCollatzReduction`, `IsClosedStackPatternSet`, `HasStackedCollatzReduction`, `HasStackReduction`, `HasOdometerReduction`, `HasTransducerReduction`, `IsValidAcceleration`, `CollatzHalts`, `IsHalt`, `IsNotHalt`), and - `load_rle_machine%` once, and states all 709 `BB(6)` and `BB(3, 3)` holdout theorems + `load_rle_machine%` once, and states all 735 `BB(6)` and `BB(3, 3)` holdout theorems (`is_closed_pattern_set` / `is_closed_stack_pattern_set`, `has_collatz_reduction` / `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, - `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, - `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, - `acceleration_iff_highLevel_acceleration`, A6 `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, and the 74 - `HardnessEvidence` live-hazard witness and halting residue-class theorems across the 95 machines) - with `sorry`. + `has_transducer_reduction`, `is_closed_segmented_system`, `is_valid_acceleration`, + `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, + `acceleration_iff_highLevel_acceleration`, A6 `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, the 74 + `HardnessEvidence` live-hazard witness and halting residue-class theorems across the 95 machines, + and the Hard holdout theorems) with `sorry`. Comparator exports both the challenge module (`Challenge` or `BusyBeaverChallenge`) and the solution module (`Cryptids` or `BusyBeaver`) via `leanexport`, verifying in a Bubblewrap sandbox @@ -64,7 +64,7 @@ that: | [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 16 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), first-order `PA` consistency & $\Sigma_1^0$ adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), `Riemann95.candidate_fewer_states`, and the `ErdosTernary14` reduction, and `Brocard28.halts_brocard28_iff_exists_square` | | [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 36 conjecture-checking state-reduction, equivalence, `PA` metatheory & internalized `ZF` provability, and semantics theorems | | [`pa_semantics.json`](./pa_semantics.json) | `Challenge` | `Cryptids.Semantics.PA` | `propext`, `Quot.sound`, `Classical.choice` | `not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`, `paProvable_sound_nat`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent` | -| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 709 `BB(6)` and `BB(3, 3)` holdout Level A, Level B, equivalence, A6 `is_not_halt`, and hardness-evidence theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`, `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, `HardnessEvidence.*`, `is_word_run_cryptid`, `is_segmented_cryptid`, `is_odometer_cryptid`, `is_stack_cryptid`, `is_cryptid`) | +| [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 735 `BB(6)` and `BB(3, 3)` holdout Level A, Level B, equivalence, A6 `is_not_halt`, and hardness-evidence theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `has_stack_reduction`, `has_odometer_reduction`, `has_transducer_reduction`, `is_closed_segmented_system`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`, `is_not_halt`, `isHalt_HHH1LC_iff_HHH0LA`, `HardnessEvidence.*`, `is_word_run_cryptid`, `is_segmented_cryptid`, `is_odometer_cryptid`, `is_stack_cryptid`, `is_cryptid`) | | [`a6.json`](./a6.json) | `BusyBeaverChallenge` | `BusyBeaver.BB6.M_1RB0LF_1RC0RA_1LD0RB_0LE0LC_0LA0LC_0LBHHH` | `propext`, `Quot.sound`, `Classical.choice` | A6 `is_not_halt` | | [`goldbach_21.json`](./goldbach_21.json) | `Challenge` | `Cryptids.Goldbach21` | `propext`, `Quot.sound` | `candidate_fewer_states`, `candidate_equivalent` | | [`goldbach_semantics.json`](./goldbach_semantics.json) | `Challenge` | `Cryptids.Semantics.Goldbach` | `propext`, `Quot.sound`, `Classical.choice` | `halts_reference_iff_not_goldbach`, `halts_candidate_iff_not_goldbach` | diff --git a/comparator/busy_beaver.json b/comparator/busy_beaver.json index 8a0b0339..05463590 100644 --- a/comparator/busy_beaver.json +++ b/comparator/busy_beaver.json @@ -700,10 +700,13 @@ "BusyBeaver.M_1RBHHH_1RC1LF_1LD1RE_1LB0LD_1RA0RC_1RC0LE.is_not_halt", "BusyBeaver.M_1RBHHH_1RC1RA_1RD0RB_1LE1RC_1LF0LE_1RC0LC.is_not_halt", "BusyBeaver.M_1RBHHH_1RC1RE_1LD0RC_0RE0LD_1LC0LF_1RA0RF.is_not_halt", + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.is_closed_segmented_system", "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.is_closed_segmented_system", "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.is_segmented_cryptid", "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.is_odometer_cryptid", "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.is_closed_segmented_system", "BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.is_segmented_cryptid", "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.is_stack_cryptid", "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.is_stack_cryptid", @@ -712,15 +715,27 @@ "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.is_stack_cryptid", "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.is_stack_cryptid", "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.is_stack_cryptid", + "BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.is_closed_segmented_system", "BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.is_segmented_cryptid", + "BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.is_closed_segmented_system", "BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.is_segmented_cryptid", + "BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.is_closed_segmented_system", "BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.is_segmented_cryptid", + "BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.is_closed_segmented_system", "BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.is_segmented_cryptid", + "BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.is_closed_segmented_system", "BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.is_segmented_cryptid", + "BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.is_closed_segmented_system", "BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.is_segmented_cryptid", + "BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.is_closed_segmented_system", "BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.is_segmented_cryptid", + "BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.is_closed_segmented_system", "BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.is_segmented_cryptid", "BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.is_odometer_cryptid", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.is_closed_pattern_set", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.has_collatz_reduction", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.is_valid_acceleration", + "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.isHalt_iff_acceleration", "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.is_cryptid" ], "permitted_axioms": [ @@ -728,29 +743,5 @@ "Quot.sound", "Classical.choice" ], - "definition_names": [ - "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.target_tm", - "BusyBeaver.M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.target_tm", - "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.target_tm", - "BusyBeaver.M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.target_tm", - "BusyBeaver.M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.target_tm", - "BusyBeaver.M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.target_tm", - "BusyBeaver.M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.target_tm", - "BusyBeaver.M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.target_tm", - "BusyBeaver.M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.target_tm", - "BusyBeaver.M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.target_tm", - "BusyBeaver.M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.target_tm", - "BusyBeaver.M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.target_tm", - "BusyBeaver.M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.target_tm", - "BusyBeaver.M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.target_tm", - "BusyBeaver.M_1RBHHH_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA.target_tm", - "BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.target_tm", - "BusyBeaver.viewPrefixLen" - ] -} \ No newline at end of file + "definition_names": [] +}