diff --git a/.github/workflows/busy_beaver_ci.yml b/.github/workflows/busy_beaver_ci.yml index 88a7a8ef..be5aee77 100644 --- a/.github/workflows/busy_beaver_ci.yml +++ b/.github/workflows/busy_beaver_ci.yml @@ -13,6 +13,8 @@ on: - 'lakefile.toml' - 'lake-manifest.json' - 'lean-toolchain' + - 'tools/**' + - 'CORE_MANIFEST.json' - '.github/workflows/busy_beaver_ci.yml' pull_request: paths: @@ -26,6 +28,8 @@ on: - 'lakefile.toml' - 'lake-manifest.json' - 'lean-toolchain' + - 'tools/**' + - 'CORE_MANIFEST.json' - '.github/workflows/busy_beaver_ci.yml' workflow_dispatch: @@ -45,6 +49,10 @@ 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 + - 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/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..a50b4c3c --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LAHHH.lean @@ -0,0 +1,650 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +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] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + 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 + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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_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 + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..ff08bbba --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LCHHH.lean @@ -0,0 +1,643 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LA_0RC0RB_1LD1LA_1LC1RE_1RF0RD_1LC---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_zWord L + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by + 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 + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..fb0d92ab --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RAHHH.lean @@ -0,0 +1,549 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---` (`IsOdometerCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LD_1RC1RF_1RA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +@[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] private theorem z00 : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl + +@[simp] private theorem zDh : (default : zB).head = 0 := rfl +@[simp] private theorem zDt : (default : zB).tail = default := rfl + +private theorem zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] + +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⟩ + +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] + +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] + +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⟩ + +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⟩ + +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 + +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) + +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))) + +private theorem fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by + match b with + | ⟨0, _⟩ => left; rfl + | ⟨1, _⟩ => right; rfl + +private inductive OdomTok where + | L0 + | L1 + | L2 +deriving DecidableEq, Repr + +@[simp] +private def odomWord : OdomTok → List (Fin 2) + | .L0 => [0, 0, 1, 0] + | .L1 => [1, 0, 1, 0] + | .L2 => [1, 1, 0] + +@[simp] +private def encOdom : List OdomTok → zB + | [] => [1] +> default + | t :: l => odomWord t +> encOdom l + +private theorem 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] private def state_R (_ : List OdomTok) : Fin 6 := 2 + +@[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] private def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomL .leftOdom 0 [1, 0] (encOdom l) r + +private def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w + +private def init_w0 : zB := default + +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 + ]; execute + +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]; execute + +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]; execute + +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]; execute + +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]; execute + +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 + ]; execute + +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]; execute + +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]; execute + +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]; execute + +@[simp] +private def cap : List OdomTok → Nat + | [] => 0 + | .L0 :: l => 2 * cap l + 1 + | .L1 :: l => 2 * cap l + | .L2 :: l => cap l / 3 + +@[simp] +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)) + +private def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l + +@[simp] +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 => + cases l with + | nil => rfl + | cons t tl => cases t <;> simp [dec_fuel, ih] + +@[simp] +private theorem length_dec (l : List OdomTok) : (dec l).length = l.length := + length_dec_fuel l.length l + +@[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] + +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 => + 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 + +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 + +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 + | 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)))))) + +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] +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] +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) + +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) _ + +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 => + 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] + +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 + +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] + +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 + | 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)))) + +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 + +private def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := + if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) + +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 + · exact runHL_dec l w hcap + · have hz : cap l = 0 := by omega + exact run_drain l w hz + +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') ∨ + (∃ 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 + +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 + 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⟩ + +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 + 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)))))))))) + + +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, + 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..6944f359 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RBHHH.lean @@ -0,0 +1,1454 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0LC0RE_1LA0RD_0RB0LF_1RC1LA_0RB---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 := 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] 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] private theorem zero_cons_default : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> 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 + +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] 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] + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +local notation3 l " <{{" q "}}ₘ " r => (r {{q}}> l) + +private abbrev cfgA (l r : ListBlank (Fin 2)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, r, l⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + evalStackCfg .M0 R L + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +private theorem in_stack_M0 (L R : List (ℕ × ℕ)) : IsInStackSystem (cfg_M0 L R) := + ⟨.M0, R, L, rfl⟩ + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + execute 5 + +-- ============================================================================ +-- Intermediate Configurations (`cfg_D`, `wall`, `P_cfg`, `F_cfg`) +-- ============================================================================ + +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)) + +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'' + +private def P_cfg (L'' : List (ℕ × ℕ)) (W : List (Fin 2)) (R : List (ℕ × ℕ)) + : Cfg (Fin 2) (Fin 6) := + cfgA (W +> wall L'') (encRight R) + +private inductive FState + | F00 | F01 | F02 | F04 | F05 | F07 +deriving DecidableEq + +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) + +-- ============================================================================ +-- Stage 1: `cfg_M0 L R` -> `cfg_M0`, Halt, or `cfg_D 0` +-- ============================================================================ + +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 + +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 + +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 + +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 + +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 + rw [cfg_M0_eq, encTail_succ (d + 2), encTail_succ (d + 1), encTail_succ d] + execute 3 + +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'⟩ + · 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` +-- ============================================================================ + +private def measureD : List (ℕ × ℕ) → ℕ + | [] => 0 + | (a, _) :: L => a + 1 + measureD L + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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)) + +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 ∨ + (∃ 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) +-- ============================================================================ + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +private def C0 : FState → ℕ + | .F00 => 0 | .F01 => 0 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 + +private def C1 : FState → ℕ + | .F00 => 1 | .F01 => 1 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +-- Stage 3 P transitions +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 5 + +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 + 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 + +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 + 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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (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 _ | ⟨_, _⟩ + · 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 => + 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 + +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) + (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 _ | ⟨_, _⟩ + · 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₁)⟩ + | 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 + +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 => + 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` +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 +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 +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 +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⟩ + | 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⟩ + +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 + 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 +-- ============================================================================ + +private 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₃⟩ + + +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, + 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 +-- ============================================================================ + +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. -/ +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 + 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. -/ +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 + 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`. -/ +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'''⟩ + · 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`. -/ +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 + | 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`. -/ +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) + 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`. -/ +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`. -/ +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 [] []`. -/ +private 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 ≠ []`). -/ +private def ValidStack278 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +private theorem validStack278_subset_isInStackSystem : + ∀ cfg, ValidStack278 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +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)⟩⟩ + +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 [] [] + 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₁⟩ + +private 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⟩ + +private 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`. -/ +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) + 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`. -/ +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 + 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₁)]`. -/ +private 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`. -/ +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') ∧ + (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`. -/ +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''')) ∧ + ∃ 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..616dc555 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RAHHH.lean @@ -0,0 +1,695 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LD_0RC1RD_1LA1RA_1LE0LE_1RF0LA_0RA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +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 + +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 + +def encLeft (S : List ℕ) : zB := + List.rec default (fun d _ acc => lWord d +> acc) S + +@[simp] private theorem encLeft_nil : encLeft [] = default := rfl +@[simp] private theorem encLeft_cons (d : ℕ) (S : List ℕ) : + encLeft (d :: S) = lWord d +> encLeft S := rfl + +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 ℕ + +@[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)] + +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] + +private theorem evalSegRegion_lWord (L : List ℕ) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +private theorem evalSegRegion_rWord (R : List ℕ) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem enc_nth_zero (d : ℕ) (L : List ℕ) : + (encLeft (d :: L)).nth 0 = 1 := by + simp only [encLeft_cons, lWord, ListBlank.append, WordRunStack.nth_cons_zero] + +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_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 => + 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) + +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_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) + 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) + +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)) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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))) ∨ + (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 + +private theorem one_cons_encLeft (xs : List ℕ) : + (1 : Fin 2) >> encLeft xs = encLeft (bump1L xs) := by + 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 + +private theorem zero_cons_encRight (xs : List ℕ) : + (0 : Fin 2) >> encRight xs = encRight (push0R xs) := by + cases xs <;> simp [push0R, encRight_nil, encRight_cons, rWord_succ] + +@[simp] +def s₀ : SegState := (.mAR, (0 :: []), (1 :: [])) + +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_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 + +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)) : + ∃ 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⟩ + +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, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encRight_nil, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute +private theorem step_mAR_2 (Rt : List ℕ) : + (evalSegCfg .mAR [] (0 :: Rt)) [target_tm]⊢⁺ + evalSegCfg .mEL [] (0 :: (push0R Rt)) := by + simp only [evalSegCfg, applyView, ← zero_cons_encRight, + encLeft_nil, encRight_cons, rWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute +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_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, ← 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 +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, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encRight_nil, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +private theorem step_mA0R_10 (L : List ℕ) : + (evalSegCfg .mA0R L []) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: L) (1 :: []) := by + 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, + default_head, default_tail] + execute +private theorem step_mA0R_11 (rt1 : List ℕ) : + (evalSegCfg .mA0R [] (0 :: rt1)) [target_tm]⊢⁺ + evalSegCfg .mEL [] (0 :: (push0R rt1)) := by + 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 +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, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +private theorem step_mA0R_14 (L : List ℕ) : + (evalSegCfg .mA0R L (1 :: [])) [target_tm]⊢⁺ + evalSegCfg .mEL (1 :: L) (0 :: []) := by + 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 +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, ← 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 +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, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +private theorem step_mA0R_17 (L : List ℕ) : + (evalSegCfg .mA0R L (2 :: [])) [target_tm]⊢⁺ + evalSegCfg .mAR (0 :: (0 :: L)) [] := by + 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, + default_head, default_tail] + execute +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, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, + encLeft_cons, encRight_cons, lWord, rWord_zero, rWord_succ, + onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +private theorem step_mEL_21 : + (evalSegCfg .mEL [] []) [target_tm]⊢⁺ + evalSegCfg .mA0R (0 :: []) [] := by + simp only [evalSegCfg, applyView, + encLeft_nil, encLeft_cons, encRight_nil, lWord, onesSep0_zero, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute +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_nil, encRight_cons, + rWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + refine ⟨_, h1, ?_⟩ + simp [step, target_tm, Turing.ListBlank.head_cons] +private theorem step_mEL_23 (rt2 : List ℕ) : + (evalSegCfg .mEL [] (1 :: rt2)) [target_tm]⊢⁺ + evalSegCfg .mA0R (0 :: []) (0 :: rt2) := by + 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 +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, + 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 +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, ← zero_cons_encRight, + encLeft_cons, lWord, onesSep0_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute +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, ← 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 +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, ← zero_cons_encRight, + encLeft_cons, encRight_cons, lWord, rWord_zero, + onesSep0_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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⟩⟩ + | 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⟩⟩ + +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⟩⟩ + · 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..53457e16 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0REHHH.lean @@ -0,0 +1,1481 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA0LF_0LC0RA_0RE---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F04 | F05 | F07 +deriving DecidableEq + +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) + | .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` +-- ============================================================================ + +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 + +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 + +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 + +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 + +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] + 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 + +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] + execute 6 + +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 + +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 + +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'⟩ + · 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` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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) +-- ============================================================================ + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +private def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F04 => 1 | .F05 => 0 | .F07 => 1 + +private def C1 : FState → ℕ + | .F00 => 1 | .F01 => 2 | .F02 => 0 | .F04 => 0 | .F05 => 1 | .F07 => 0 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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 +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +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 + 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 + +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 +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 +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 +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 +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 +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 +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 _ _ +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 +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 +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 +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 +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (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 _ | ⟨_, _⟩ + · 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 => + 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 + +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) + (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 + +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 => + 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` +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 +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 +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 +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⟩ + | 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⟩ + +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 + 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 +-- ============================================================================ + +private 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₃⟩ + + +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, + 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 +-- ============================================================================ + +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. -/ +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 + 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. -/ +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 + 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`. -/ +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'''⟩ + · 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`. -/ +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 + | 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`. -/ +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) + 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')`. -/ +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')`. -/ +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')`. -/ +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 [] []`. -/ +private 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 ≠ []`). -/ +private def ValidStack223 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +private theorem validStack223_subset_isInStackSystem : + ∀ cfg, ValidStack223 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +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)⟩⟩ + 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 + +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)⟩⟩ + +private 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⟩ + +private 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`. -/ +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' := + ⟨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`. -/ +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' := + ⟨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`. -/ +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) + 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₁)] []`. -/ +private 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`. -/ +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 + 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`. -/ +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') ∧ + (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`. -/ +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') ∧ + (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`. -/ +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'')) ∧ + ∃ 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..2a2e103d --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LBHHH.lean @@ -0,0 +1,1763 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LB---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 + | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +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) + | .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` +-- ============================================================================ + +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 + +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 + +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 + +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 + +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] + 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 + +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] + execute 6 + +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 + +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 + +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'⟩ + · 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` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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) +-- ============================================================================ + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +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 + +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 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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 +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +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 + 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 + +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 _ _ +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 +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 +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 +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 +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 +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 +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 +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 +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 _ _ +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 +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 +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (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 _ | ⟨_, _⟩ + · 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₁)⟩ + | 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 + +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) + (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₁⟩ + +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 => + 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` +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 +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 +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 +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 +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 +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 +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⟩ + | 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⟩ + +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 + 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 +-- ============================================================================ + +private 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₃⟩ + + +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, + 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 +-- ============================================================================ + +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. -/ +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 + 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. -/ +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 + 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`. -/ +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'''⟩ + · 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`. -/ +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 + | 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`. -/ +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) + 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')`. -/ +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')`. -/ +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')`. -/ +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 [] []`. -/ +private 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 ≠ []`). -/ +private def ValidStack325 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +private theorem validStack325_subset_isInStackSystem : + ∀ cfg, ValidStack325 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +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)⟩⟩ + 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 + +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)⟩⟩ + +private 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⟩ + +private 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`. -/ +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' := + ⟨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`. -/ +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' := + ⟨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`. -/ +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) + 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₁)] []`. -/ +private 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`. -/ +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 + 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`. -/ +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') ∧ + (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`. -/ +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') ∧ + (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`. -/ +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'')) ∧ + ∃ 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..e8d54baf --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LEHHH.lean @@ -0,0 +1,1752 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RA_0LE---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 + | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +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) + | .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` +-- ============================================================================ + +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 + +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 + +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 + +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 + +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] + 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 + +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] + execute 6 + +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 + +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 + +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'⟩ + · 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` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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) +-- ============================================================================ + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +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 + +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 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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 +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_succ 0 b, encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 3 + +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 + 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 + +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 _ _ +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 +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 +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 +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 +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 +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 +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 +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 +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 _ _ +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 +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 +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (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 _ | ⟨_, _⟩ + · 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₁)⟩ + | 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 + +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) + (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₁⟩ + +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 => + 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` +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 +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 +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 +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 +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 +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 +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⟩ + | 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⟩ + +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 + 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 +-- ============================================================================ + +private 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₃⟩ + + +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, + 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 +-- ============================================================================ + +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. -/ +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 + 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. -/ +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 + 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`. -/ +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'''⟩ + · 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`. -/ +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 + | 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`. -/ +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) + 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')`. -/ +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')`. -/ +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')`. -/ +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 [] []`. -/ +private 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 ≠ []`). -/ +private def ValidStack304 (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R ∧ (L ≠ [] ∨ R ≠ []) + +private theorem validStack304_subset_isInStackSystem : + ∀ cfg, ValidStack304 cfg → IsInStackSystem cfg := by + intro cfg ⟨m, L, R, hcfg, _⟩ + exact ⟨m, L, R, hcfg⟩ + +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)⟩⟩ + 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 + +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)⟩⟩ + +private 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⟩ + +private 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`. -/ +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' := + ⟨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`. -/ +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' := + ⟨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`. -/ +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) + 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₁)] []`. -/ +private 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`. -/ +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 + 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`. -/ +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') ∧ + (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`. -/ +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') ∧ + (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`. -/ +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'')) ∧ + ∃ 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..2a3dc800 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LAHHH.lean @@ -0,0 +1,1753 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 | F12 | F13 +deriving DecidableEq + +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'') <{{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` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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 +-- ============================================================================ + +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] + +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 + | 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] + +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 + 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 + +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 + 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 + +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')] + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +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 + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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 + 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 + +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 + +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +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 +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 +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 +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 _ _ +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 +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 +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 +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 _ _ +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 +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 +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 +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 _ _ + +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (_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 + +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) + (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₁⟩ + +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 → + (∀ 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⟩ + +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 => + 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, 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 + ⟨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⟩ + +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 + +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 + +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 + +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 + +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 + +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⟩ + | 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⟩ + +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 + 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 +-- ============================================================================ + +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 + 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⟩⟩ + +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) + | 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 + +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 + +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 + +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 + +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 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +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 + 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 + +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' + 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, 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 + 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 + +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'⟩ + · 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)⟩ + +private 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₃⟩ + + +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, + 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..888d04fa --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LCHHH.lean @@ -0,0 +1,1550 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_0LC---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + +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 + +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 +deriving DecidableEq + +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'') <{{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` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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 +-- ============================================================================ + +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] + +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 + | 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] + +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 + 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 + +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 + 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 + +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')] + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +private 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 C1 : FState → ℕ + | .F00 => + 1 | .F01 => + 0 | .F02 => + 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 1 | .F07 => 2 | .F08 => 1 | .F09 => 1 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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 + 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 + +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 + +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +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 +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 +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 +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 _ _ +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 +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 +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 +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 _ _ + +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (_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 + +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) + (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₁⟩ + +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 → + (∀ 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⟩ + +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 => + 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, 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 + ⟨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⟩ + +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 + +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 + +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, 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 + +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 + +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 + +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 + +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 + +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 + 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⟩⟩ + +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 + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +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 + 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⟩⟩ + +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) + | 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 + +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 + +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 + +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 + +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 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +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 + 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 + +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' + 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, 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 + 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 + +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'⟩ + · 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)⟩ + +private 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₃⟩ + + +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, + 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..90103233 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LAHHH.lean @@ -0,0 +1,1560 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + +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 + +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 +deriving DecidableEq + +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'') <{{A}} encRight R + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +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 + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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 +-- ============================================================================ + +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] + +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 + | 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] + +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 + 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 + +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 + 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 + +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')] + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +private def C0 : FState → ℕ + | .F00 => 0 | .F01 => 1 | .F02 => 1 | .F03 => 0 | .F04 => 1 | .F05 => 1 | .F06 => 1 + +private def C1 : FState → ℕ + | .F00 => 1 | .F01 => 0 | .F02 => 0 | .F03 => 1 | .F04 => 0 | .F05 => 0 | .F06 => 0 + +private theorem C0_le_C1_succ (s : FState) : C0 s ≤ C1 s + 1 := by + cases s <;> decide + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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 + 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 + +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 + +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 +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 +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 +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 +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 +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 +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] + +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 .F03 L'' W R := by + dsimp only [F_cfg]; execute 1 +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 +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 +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 +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 _ _ +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 + +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (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⟩ + +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) + (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₁)⟩ + +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 → + (∀ 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⟩ + +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 => + 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, 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 + ⟨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⟩ + +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 + +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 + +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'') ((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 + +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 + +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 + 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⟩⟩ + +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 + 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 +-- ============================================================================ + +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) + | 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 + +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 + +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 + +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 + +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 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +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 + 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 + +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' + 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, 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 + 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 + +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'⟩ + · 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)⟩ + +private 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₃⟩ + + +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, + 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..73cb197a --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LEHHH.lean @@ -0,0 +1,1700 @@ +/- +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 + + +/-! +# Busy Beaver Machine `1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---` (`IsStackCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0LE_1LC0RE_0RA0LD_1LA1LF_0LC0RE_1LE---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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 + +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] + +-- ============================================================================ +-- 2nd-Order Digit-Stack Encodings (`pol = 0, maxSepL = 4, maxSepR = 4`) +-- ============================================================================ + +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)) + +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) + +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] private theorem encLeft_tail (S : List (ℕ × ℕ)) : (encLeft S).tail = encTail S := by + rw [encLeft_eq_encRight]; rfl + +private theorem encRight_tail (S : List (ℕ × ℕ)) : (encRight S).tail = encTail S := rfl + +@[simp] private theorem encTail_nil : encTail [] = default := rfl + +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 + +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 + +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] + +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] + +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 + +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] + +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 + +private def bumpHead : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a + 1, b) :: S + +private def tailAsRight : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [(0, 0)] + | (a, b) :: S => (a, b) :: S + +private def rightAsTail : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b) :: S => (a + 1, b) :: S + +private def pushZeroSep (b : ℕ) : List (ℕ × ℕ) → List (ℕ × ℕ) + | [] => [] + | (a, b') :: S => (0, b) :: (a, b') :: S + +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 + +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 + +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' + +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' + +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] + +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] + +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, 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] + +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 + +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, 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, 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, ite_eq_right h1, ite_eq_right h2, encRight_cons_simp 0 b, h3, encTail_zero] + rfl + +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 +-- ============================================================================ + +private def cfg_M0 (L R : List (ℕ × ℕ)) : Cfg (Fin 2) (Fin 6) := + ⟨some A, ⟨0, (encLeft L).tail, (encRight R).tail⟩⟩ + +private inductive StackMode + | M0 +deriving DecidableEq + +private def evalStackCfg : StackMode → List (ℕ × ℕ) → List (ℕ × ℕ) → Cfg (Fin 2) (Fin 6) + | .M0, L, R => cfg_M0 L R + +private def IsInStackSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ m L R, cfg = evalStackCfg m L R + +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] + +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)⟩ + +private theorem audit_encRight_head (d b : ℕ) (R : List (ℕ × ℕ)) : + (encRight ((d, b) :: R)).head = 1 := by + rw [encRight_cons_simp, Turing.ListBlank.head_cons] + +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 + +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, ?_⟩ + 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 + +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])⟩ + +-- ============================================================================ +-- 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)) + +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] + +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] + 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`) +-- ============================================================================ + +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)) + +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'' + +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⟩⟩ + +private inductive FState + | F00 | F01 | F02 | F03 | F04 | F05 | F06 | F07 | F08 | F09 | F10 | F11 +deriving DecidableEq + +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) + | .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 +-- ============================================================================ + +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] + +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 + | 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] + +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 + 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 + +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 + 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 + +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')] + +private def w : List (ℕ × ℕ) → ℕ + | [] => 0 + | [(a, _)] => a + | (a, b) :: r₂ :: rs => a + b % 2 + w (r₂ :: rs) + +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 + +private theorem C1_le_C0_succ (s : FState) : C1 s ≤ C0 s + 1 := by + cases s <;> decide + +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 + +private theorem 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 + +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 + · 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, 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, 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, ite_eq_right h1, ite_eq_right h2] + simp [w, hb2] + +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 + +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⟩ + · contradiction + · unfold P_cfg + rw [encRight_cons_simp, hb, encRight_cons_eq_one_cons_encTail] + execute 4 + +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 + 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 + +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 + 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 + +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 + +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 .F03 L'' W (R) := by + dsimp only [F_cfg]; execute 1 +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 +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 +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 +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 _ _ +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 +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 +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 +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 +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 _ _ +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 + +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)) + +private def Q0 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' W_base R) L'' W_base (w R) C0 + +private def Qz (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: W_base) R) L'' W_base (w R) C1 + +private def Qz1 (R : List (ℕ × ℕ)) : Prop := + ∀ L'' W_base, Stage3Out (P_cfg L'' (0 :: 1 :: W_base) R) L'' W_base (w R) C0 + +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) + (_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 + +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) + (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⟩ + +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 → + (∀ 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⟩ + +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 => + 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, 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 + ⟨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⟩ + +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 + +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 + +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'') ((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 + +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 + +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 + +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 + +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 + +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 + +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 + +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 + 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⟩⟩ + +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 + +-- ============================================================================ +-- Stage 1: Unified `cfg_M0 L R` -> `cfg_M0`, `cfg_D 0`, or Halt +-- ============================================================================ + +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 + 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⟩⟩ + +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) + | 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 + +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 + +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 + +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 + +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 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 6 + +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), + listblank_append_cons, ← encTail_peelSep] + execute 7 + +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 + 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 + +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 + · 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, 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 + 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 + +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') + +-- Stage 2: `cfg_D c L R` (`c < 4`) -> `cfg_M0`, Halt, or `P_cfg` +-- ============================================================================ + +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 + +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] + +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] + +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] + +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] + +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 + +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 + +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 + +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 + +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 + +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) ∨ + (∃ 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 _ _))⟩ + +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 ∨ + (∃ 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⟩ + +-- ============================================================================ + +-- ============================================================================ + + +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'⟩ + · 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)⟩ + +private 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₃⟩ + + +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, + 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..756aa1b6 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RA_0LC0RE_1LE1LD_0LEHHH_1LF0LC_1RA1LE.lean @@ -0,0 +1,733 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RA_0LC0RE_1LE1LD_0LE---_1LF0LC_1RA1LE" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +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]`. -/ +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]`. -/ +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 + +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 ℕ + +@[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)] + +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] + +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +private theorem evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encRight R := + evalSegRegion_zWord R + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] + +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_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_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_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) + +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_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_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) + 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_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_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) + +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 + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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]) + +private theorem zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] + +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_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] + +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_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 + +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +private theorem step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_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 + +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_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_nil, encLeft_cons, lWord_zero_false, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +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 + | 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 +private theorem step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +-- Mode mA0 (0> with leading 0) transitions +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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 + | 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⟩⟩ + +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 +/-- 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 new file mode 100644 index 00000000..4d8fffc2 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RAHHH.lean @@ -0,0 +1,734 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1LC1RA_1LD0LC_0RE0LA_1RA1RF_0RA---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +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]`. -/ +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]`. -/ +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 + +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 ℕ + +@[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)] + +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] + +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +private theorem evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_zWord R + +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] + +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_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_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_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) + +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_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_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) + 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_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_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) + +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 + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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))) ∨ + (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]) + +private theorem zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] + +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_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] + +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_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 + +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +private theorem step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_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 + +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_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_nil, encLeft_cons, lWord_zero_false, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +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 + | 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 +private theorem step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +-- Mode mA0 (0> with leading 0) transitions +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..458ed12d --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RE_1RCHHH_0RD0RC_1LE1LF_1LD1RA_1RC0LF.lean @@ -0,0 +1,653 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RE_1RC---_0RD0RC_1LE1LF_1LD1RA_1RC0LF" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +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] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_nil, + zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..6489b1f8 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1LF1LD_1RE0LD_0RC0RE_1LC1RA.lean @@ -0,0 +1,643 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1LF1LD_1RE0LD_0RC0RE_1LC1RA" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_zWord L + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 0)] := by + 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 + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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, encRight_cons, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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, encRight_cons, rWord_zero, rWord_succ, oRun_zero, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..9f1a9599 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB0RF_1LCHHH_1RD0LC_0RE0RD_1LF1LC_1LE1RA.lean @@ -0,0 +1,653 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB0RF_1LC---_1RD0LC_0RE0RD_1LF1LC_1LE1RA" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +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] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + 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 + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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_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 + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..d7defc7f --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RBHHH.lean @@ -0,0 +1,733 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB1RF_1RC0RA_1LD1RB_1LE0LD_0RA0LB_0RB---" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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 + +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) + +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]`. -/ +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]`. -/ +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 + +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 ℕ + +@[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)] + +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] + +private theorem evalSegRegion_lWord (L : List (ℕ × Bool)) : + evalSegRegion (.finWord (L.map lWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (lWord p) (evalSegRegion (.finWord (rest.map lWord))) default + +private theorem evalSegRegion_zWord (R : List ℕ) : + evalSegRegion (.finWord (R.map zWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons z rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (zWord z) (evalSegRegion (.finWord (rest.map zWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsL (m, L, R)) = encLeft L := + evalSegRegion_lWord L + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List (ℕ × Bool)) (R : List ℕ) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_zWord R + +private theorem encLeft_nth_zero (p : ℕ × Bool) (L : List (ℕ × Bool)) : + (encLeft (p :: L)).nth 0 = 1 := by + rcases p with ⟨_ | d, _ | _⟩ <;> + simp only [encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append, WordRunStack.nth_cons_zero] + +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_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_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_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) + +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_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_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) + 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_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_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) + +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 + | (d, b) :: p :: L => + noFactor_0001_lWord_cons d b (encLeft (p :: L)) (encLeft_nth_zero p L) + (noFactor_0001_encLeft (p :: L)) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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))) ∨ + (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)], []) + +private theorem zero_cons_encRight (R : List ℕ) : + (0 : Fin 2) >> encRight R = encRight (push0R R) := by + cases R <;> simp [push0R, encRight_nil, encRight_cons, zWord_succ] + +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_nil, encLeft_cons, lWord_zero_false, lWord_succ_false, lWord_zero_true, + lWord_succ_true, ListBlank.append] + +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_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +private theorem step_cfgHalt_isNone (L : List (ℕ × Bool)) (Rt : List ℕ) : + (step target_tm (cfgHalt L Rt)).isNone := by + simp [cfgHalt, encRight_cons, zWord_zero, ListBlank.append, + Turing.ListBlank.head_cons, step, target_tm] + +-- Mode mCL (<2) transitions +private theorem step_mCL_nil_nil : + (evalSegCfg .mCL [] []) [target_tm]⊢⁺ evalSegCfg .mA0 [(0, false)] [] := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, encRight_nil, + lWord_zero_false, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_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 + +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_nil, encLeft_cons, encRight_cons, + lWord_zero_false, zWord_succ, + ListBlank.append, + zero_cons_default, default_head, default_tail] + execute + +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_nil, encLeft_cons, lWord_zero_false, + + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + zero_cons_default] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, lWord_succ_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, lWord_zero_false, + lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, lWord_zero_false, + lWord_zero_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, + lWord_zero_false, lWord_succ_false, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +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_cons, + lWord_zero_true, lWord_succ_true, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute) + +@[simp] +def push00IterR : ℕ → List ℕ → List ℕ + | 0, R => R + | k + 1, R => push00IterR k (push0R (push0R R)) + +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 + | 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 +private theorem step_mAR_nil (L : List (ℕ × Bool)) : + (evalSegCfg .mAR L []) [target_tm]⊢⁺ evalSegCfg .mCL L [1] := by + simp only [evalSegCfg, applyView, encRight_nil, encRight_cons, zWord_zero, zWord_succ, + ListBlank.append, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_false, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, + zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +-- Mode mA0 (0> with leading 0) transitions +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_cons, encRight_nil, encRight_cons, + lWord_zero_false, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, encRight_nil, encRight_cons, + lWord_zero_true, zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail] + execute + +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_cons, + encRight_cons, lWord_zero_true, + zWord_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_true, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, lWord_succ_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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_cons, encRight_cons, + lWord_zero_false, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons] + execute + +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 + | 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⟩⟩ + +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 +/-- 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 new file mode 100644 index 00000000..e7444050 --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD.lean @@ -0,0 +1,653 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_0RC0RB_1LD1LE_1LC1RF_1RB0LE_1RA0RD" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +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] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encRight R := + evalSegRegion_rWord R + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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) ∨ + (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], []) + +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_nil, encLeft_cons, encRight_nil, + zWord_zero, + ListBlank.append, + default_head, default_tail] + execute + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_nil, + zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..f7a51fee --- /dev/null +++ b/BusyBeaver/BB6/Accelerations/M_1RBHHH_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE.lean @@ -0,0 +1,660 @@ +/- +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 + +/-! +# Busy Beaver Machine `1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE` (`IsSegmentedCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1LC0RB_0LD0LC_1RE1RB_1RD1LF_1LA0LE" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +@[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) ?_ <;> + 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]`. -/ +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`. -/ +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`). -/ +def rWord (p : ℕ × ℕ) : List (Fin 2) := + Nat.rec (oRun p.2) (fun _ acc => 0 :: acc) p.1 + +@[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 + +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 (ℕ × ℕ) + +@[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)] + +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] + +private theorem evalSegRegion_zWord (L : List ℕ) : + evalSegRegion (.finWord (L.map zWord)) +> (default : zB) = encLeft L := by + induction L with + | nil => simp [evalSegRegion, encLeft_nil] + | cons k rest ih => + simp only [List.map_cons, evalSegRegion, encLeft_cons, ← ih] + exact append_assoc_blank (zWord k) (evalSegRegion (.finWord (rest.map zWord))) default + +private theorem evalSegRegion_rWord (R : List (ℕ × ℕ)) : + evalSegRegion (.finWord (R.map rWord)) +> (default : zB) = encRight R := by + induction R with + | nil => simp [evalSegRegion, encRight_nil] + | cons p rest ih => + simp only [List.map_cons, evalSegRegion, encRight_cons, ← ih] + exact append_assoc_blank (rWord p) (evalSegRegion (.finWord (rest.map rWord))) default + +@[simp] +private theorem evalSegmentedHalf_segsL (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsL (m, L, R)) = encRight R := + evalSegRegion_rWord R + +@[simp] +private theorem evalSegmentedHalf_segsR (m : SegMode) (L : List ℕ) (R : List (ℕ × ℕ)) : + evalSegmentedHalf (segsR (m, L, R)) = encLeft (leftList m L) := + evalSegRegion_zWord (leftList m L) + +private theorem oRun_nth_one (o : ℕ) (t : zB) : (oRun o +> t).nth 1 = 1 := by + cases o with + | zero => + simp only [oRun_zero, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + | succ o => + cases o <;> + simp only [oRun_zero, oRun_succ, ListBlank.append, WordRunStack.nth_cons_succ, + WordRunStack.nth_cons_zero] + +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_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_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) + +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_zero] + exact noFactor_010_oRun o t ht + | succ z ih => + cases z with + | zero => + 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_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 + +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) + +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) + +/-- 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) + | .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 + +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 → + (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) + +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))) ∨ + (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)]) + +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_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, + 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 + +private theorem step_mAL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mAL [] R) [target_tm]⊢⁺ evalSegCfg .mB0 [0] R := by + simp only [evalSegCfg, applyView, encLeft_nil, encLeft_cons, zWord_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_nil, encRight_cons, + zWord_zero, rWord_succ, push0R, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mB0_nil (L : List ℕ) : + (evalSegCfg .mB0 L []) [target_tm]⊢⁺ evalSegCfg .mCL L [] := by + simp only [evalSegCfg, applyView, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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_nil, encLeft_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_succ, push0L, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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 + | zero => + simp only [push0IterL] + exact step_mB0_0_base L R + | succ o ih => + simp only [push0IterL] + exact stepPlus_trans (step_mB0_0_step o L R) (ih (push0L L)) + +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_cons, encRight_cons, + zWord_zero, rWord_zero, rWord_succ, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute) + +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, encRight_cons, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL [] R) [target_tm]⊢⁺ evalSegCfg .mCL [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mCL1_nil (R : List (ℕ × ℕ)) : + (evalSegCfg .mCL1 [] R) [target_tm]⊢⁺ evalSegCfg .mCL1 [] ((0, 0) :: R) := by + simp only [evalSegCfg, applyView, encLeft_nil, encRight_cons, + rWord_zero, oRun_zero, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, zWord_zero, zWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD0_nil (L : List ℕ) : + (evalSegCfg .mD0 L []) [target_tm]⊢⁺ evalSegCfg .mCL1 (1 :: L) [] := by + simp only [evalSegCfg, applyView, encLeft_cons, encRight_nil, + ListBlank.append, + default_head, default_tail]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_mD1_nil (L : List ℕ) : + (evalSegCfg .mD1 L []) [target_tm]⊢⁺ evalSegCfg .mAL L [(1, 2)] := by + 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 + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_zero, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, encRight_cons, + zWord_zero, zWord_succ, rWord_zero, oRun_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +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_cons, + encRight_cons, zWord_zero, zWord_succ, rWord_zero, rWord_succ, + ListBlank.append, Turing.ListBlank.head_cons, Turing.ListBlank.tail_cons]; execute + +private theorem step_cfgHalt_isNone (o : ℕ) (L : List ℕ) (R : List (ℕ × ℕ)) : + (step target_tm (cfgHalt L o R)).isNone := by + cases o <;> simp [cfgHalt, oRun_zero, oRun_succ, ListBlank.append, Turing.ListBlank.head_cons, + step, target_tm] + +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_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 + +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 + | 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⟩⟩ + +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 + +/-- 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 new file mode 100644 index 00000000..70e4d690 --- /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 + + +/-! +# Busy Beaver Machine `1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA` (`IsOdometerCryptid`) + +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 + +/-- The `(6, 2)` Turing machine in `ConjectureMachines.Machine` form. -/ +def machine : ConjectureMachines.Machine 6 2 := + load_rle_machine% "1RB---_1RC0LE_0LD0RF_1LB0RE_0RC0LE_1RD1RA" + +/-- The `(6, 2)` Turing machine in `BusyBeaver.Machine` form. -/ +abbrev target : Machine (Fin 2) (Fin 6) := + machine.toBB + +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) + | 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) + +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) + +@[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] private theorem z00 : (0 : Fin 2) >> default = default := by + apply Turing.ListBlank.ext; intro i; cases i <;> rfl + +@[simp] private theorem zDh : (default : zB).head = 0 := rfl +@[simp] private theorem zDt : (default : zB).tail = default := rfl + +private theorem zSm {Γ Λ : Type*} [Inhabited Γ] [Inhabited Λ] + (tm : Machine Γ Λ) (c₁ c₂ : Cfg Γ Λ) (h : c₁ [tm]⊢ c₂) : c₁ [tm]⊢^{1} c₂ := by simp [h] + +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⟩ + +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] + +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] + +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⟩ + +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⟩ + +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 + +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) + +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))) + +private theorem fin2_cases (b : Fin 2) : b = 0 ∨ b = 1 := by + match b with + | ⟨0, _⟩ => left; rfl + | ⟨1, _⟩ => right; rfl + +private inductive OdomTok where + | L0 + | L1 + | L2 +deriving DecidableEq, Repr + +@[simp] +private def odomWord : OdomTok → List (Fin 2) + | .L0 => [0, 0, 1, 0] + | .L1 => [1, 0, 1, 0] + | .L2 => [1, 1, 0] + +@[simp] +private def encOdom : List OdomTok → zB + | [] => [1] +> default + | t :: l => odomWord t +> encOdom l + +private theorem 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] private def state_R (_ : List OdomTok) : Fin 6 := 3 + +@[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] private def cfg_L (l : List OdomTok) (r : zB) : Cfg (Fin 2) (Fin 6) := + evalOdomL .leftOdom 1 [1, 0] (encOdom l) r + +private def IsInOdomSystem (cfg : Cfg (Fin 2) (Fin 6)) : Prop := + ∃ stk w, cfg = evalOdomR .leftOdom (state_R stk) [1, 0] (encOdom stk) w + +private def init_w0 : zB := (0 : Fin 2) >> 1 >> 0 >> 1 >> default + +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 + ]; execute + +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]; execute + +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]; execute + +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]; execute + +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]; execute + +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 + ]; execute + +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]; execute + +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]; execute + +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]; execute + +@[simp] +private def cap : List OdomTok → Nat + | [] => 0 + | .L0 :: l => 2 * cap l + 1 + | .L1 :: l => 2 * cap l + | .L2 :: l => cap l / 3 + +@[simp] +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)) + +private def dec (l : List OdomTok) : List OdomTok := dec_fuel l.length l + +@[simp] +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 => + cases l with + | nil => rfl + | cons t tl => cases t <;> simp [dec_fuel, ih] + +@[simp] +private theorem length_dec (l : List OdomTok) : (dec l).length = l.length := + length_dec_fuel l.length l + +@[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] + +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 => + 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 + +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 + +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 + | 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)))))) + +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] +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] +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) + +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) _ + +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 => + 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] + +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 + +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] + +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 + | 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)))) + +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 + +private def stepL_state (l : List OdomTok) (w : zB) : List OdomTok × zB := + if cap l ≥ 1 then (dec l, w) else ([], drain l +> w) + +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 + · exact runHL_dec l w hcap + · have hz : cap l = 0 := by omega + exact run_drain l w hz + +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') ∨ + (∃ 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 + +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 + 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⟩ + +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 + ]; execute + + +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, + 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..9a78baf7 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` (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`). @@ -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`, 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 | +| :--- | :--- | :--- | +| `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_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/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..e551f77f --- /dev/null +++ b/BusyBeaver/BB6/M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE.lean @@ -0,0 +1,705 @@ +/- +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 Holdout `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE` (#424) + +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 + +namespace BusyBeaver.M_1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_HHH1RE + +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 + +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 + +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 + +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 + +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 + +/-- 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 + +/-- Machine halting equivalence for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem isHalt_iff_acceleration : IsHalt target ↔ CollatzHalts next start := + is_valid_acceleration.isHalt_iff + +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 + +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⟩ + +/-- 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 + +/-- Level A Collatz-like reduction for `1RB1LE_0LC0LB_1RD1LC_1RD1RA_1RF0LA_---1RE`. -/ +theorem has_collatz_reduction : HasCollatzReduction target := + ⟨ps, is_closed_pattern_set⟩ + +/-- 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 37256a0b..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 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---`), 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,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` | `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) | @@ -1024,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/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 5715fed2..c7b67461 100644 --- a/BusyBeaver/Defs.lean +++ b/BusyBeaver/Defs.lean @@ -4,699 +4,39 @@ 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 +public import BusyBeaver.Defs.WordRun +public import BusyBeaver.Defs.Segmented /-! # 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. + - `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. + - `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. +- `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. -/ - -@[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..8832bc1e --- /dev/null +++ b/BusyBeaver/Defs/Odometer.lean @@ -0,0 +1,212 @@ +/- +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 => + (⟨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`). -/ +@[reducible, simp] +def evalOdomL {Γ Λ : Type*} [Inhabited Γ] + (side : OdomSide) (q_L : Λ) (pfx_L : List Γ) + (encOdom : ListBlank Γ) (w : ListBlank Γ) : Cfg Γ Λ := + match side with + | .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 +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)) + +/-- 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/Patterns.lean b/BusyBeaver/Defs/Patterns.lean new file mode 100644 index 00000000..31457c97 --- /dev/null +++ b/BusyBeaver/Defs/Patterns.lean @@ -0,0 +1,148 @@ +/- +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 + +/-- +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 := + ∃ 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/Segmented.lean b/BusyBeaver/Defs/Segmented.lean new file mode 100644 index 00000000..671e7ff1 --- /dev/null +++ b/BusyBeaver/Defs/Segmented.lean @@ -0,0 +1,118 @@ +/- +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 + +universe u v + +/-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ +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 u} : 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 u} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ + | [] => default + | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) + +/-- 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), and all regions must be `SegRegionKind.WellFormed`. -/ +def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (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)) Λ), + IsClosedSegmentedSystem M modes ValidSeg modeOf segsL segsR evalCfg + +end BusyBeaver diff --git a/BusyBeaver/Defs/Stack.lean b/BusyBeaver/Defs/Stack.lean new file mode 100644 index 00000000..04b059c7 --- /dev/null +++ b/BusyBeaver/Defs/Stack.lean @@ -0,0 +1,296 @@ +/- +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)) + +/-- 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/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/BusyBeaver/Defs/WordRun.lean b/BusyBeaver/Defs/WordRun.lean new file mode 100644 index 00000000..c7ebebf2 --- /dev/null +++ b/BusyBeaver/Defs/WordRun.lean @@ -0,0 +1,354 @@ +/- +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) + +section +universe u v + +/-- Prefix length of a `HalfTapeView`. -/ +def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := + 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. -/ +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) ∧ + 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')) ∧ + (∀ 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/BusyBeaver/README.md b/BusyBeaver/README.md index 3be39eee..1b7dc121 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 @@ -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 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 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)) @@ -68,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 new file mode 100644 index 00000000..780639f4 --- /dev/null +++ b/BusyBeaver/Stack.lean @@ -0,0 +1,460 @@ +module + +public import BusyBeaver.Basic +import Mathlib.Tactic.Ring + +@[expose] public section + +open Mathlib Relation Nat Turing BusyBeaver + +namespace BusyBeaver.PairStack + + +-- ============================================================================ +-- 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 + +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] + +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] 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] + +-- ============================================================================ +-- 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 +-- ============================================================================ + +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 (ℕ × ℕ)) : + 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 _ _ _ => 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. -/ +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..c212bff0 --- /dev/null +++ b/BusyBeaver/WordRunStack.lean @@ -0,0 +1,133 @@ +/- +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 + +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 3dd18431..dce54077 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,10 +185,30 @@ 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 + /-- 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 : ℕ → ℕ`. -/ @@ -186,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 : ℕ → ℕ`. -/ @@ -198,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 : ℕ → ℕ`. -/ @@ -237,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 := @@ -479,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. -/ @@ -493,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`). -/ @@ -503,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 @@ -582,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). -/ @@ -727,6 +904,425 @@ 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) + +section +universe u v + +/-- Prefix length of a `HalfTapeView`. -/ +def viewPrefixLen {Γ : Type u} (v : HalfTapeView Γ) : ℕ := + 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. -/ +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) ∧ + 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')) ∧ + (∀ 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)))) + +universe u v + +/-- Segmented Half-Tape Region Descriptor (`SegRegionKind`). -/ +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 u} : 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 u} [Inhabited Γ] : List (SegRegionKind Γ) → ListBlank Γ + | [] => default + | reg :: rest => ListBlank.append (evalSegRegion reg) (evalSegmentedHalf rest) + +/-- 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), and all regions must be `SegRegionKind.WellFormed`. -/ +def IsSegmentedCryptid {k : ℕ} {Λ : Type u} [Inhabited Λ] + (M : Machine (Fin (k + 2)) Λ) : Prop := + ∃ (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)) Λ), + IsClosedSegmentedSystem M modes ValidSeg modeOf segsL segsR evalCfg + namespace SixState /-- State `A` (`0 : Fin 6`), the initial state. -/ @@ -9324,3 +9920,925 @@ 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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 + +/-- `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 SixState Turing BusyBeaver + +/-- `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 new file mode 100644 index 00000000..71f7c580 --- /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": "c72377cfde8df4bf3634467bbfa5ead837f818beff11a78540fc19b3c5f16b2b", + "BusyBeaver/Defs/Odometer.lean": "447c59d8748a6913f6c345e238fac56975092075c0c4bcd8ee8aea6cab36f4e4", + "BusyBeaver/Defs/Transducer.lean": "12cd7052d69b41417bad77228111411b98c3dd6ec513ae7b6440eb7c23831e9f", + "BusyBeaver/Defs/WordRun.lean": "4eb9a109d509ed5af3311806ac9807e3cb3bded4462d10de2ade20272c91d5b9", + "BusyBeaver/Defs/Segmented.lean": "40f9ba866be37c7b373f4d06ebdf5cab03638181ddb8b2de52801f4a8034be84", + "BusyBeaver/Basic.lean": "35cf96b7db7ce0dbd629af00540121d4f64eb18755774356a4309eee9a6a0c4e", + "BusyBeaver/WordRLE.lean": "b819bc8e072a8b2274f60c3cae72f61dbb9057ef9481facbc68801dd4b2ce803", + "BusyBeaver/AffRLE.lean": "8434da7a25f766df93481813f0b17286337df21f35ed55f43845ca93b6903e95", + "BusyBeaver/Cert.lean": "9d23a26b5279bb83b1140920c7b62add4053e01f1f488ef98588363c4cff9496" + } +} 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 31cc4ddd..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 506 `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 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 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 6461ef3a..05463590 100644 --- a/comparator/busy_beaver.json +++ b/comparator/busy_beaver.json @@ -699,11 +699,49 @@ "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_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", + "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_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": [ "propext", "Quot.sound", "Classical.choice" - ] + ], + "definition_names": [] } 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" 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()) 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())