feat(Data): Results about RelatesInSteps with bounds on the reachable set

Cslib.lean

@@ -74,6 +74,7 @@ public import Cslib.Foundations.Data.DecidableEqZero
 public import Cslib.Foundations.Data.FinFun.Basic
 public import Cslib.Foundations.Data.FinFun.Update
 public import Cslib.Foundations.Data.HasFresh
+public import Cslib.Foundations.Data.List.IsChainFromTo
 public import Cslib.Foundations.Data.Nat.Segment
 public import Cslib.Foundations.Data.OmegaSequence.Defs
 public import Cslib.Foundations.Data.OmegaSequence.Flatten

Cslib/Computability/Machines/Turing/SingleTape/Deterministic.lean

@@ -445,7 +445,7 @@ def TimeComputable.comp {f g : List Symbol → List Symbol}
         (hg.timeBound (f a).length) hg_outputsFun
     -- Therefore, the computer reduces a to g (f a) in the sum of those times.
     have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a
-    apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a
+    refine RelatesWithinSteps.mono ?_ h_a_reducesTo_g_f_a
     refine Nat.add_le_add_left ?_ (hf.timeBound a.length)
     · apply h_mono
       -- Use the lemma about output length being bounded by input length + time

Cslib/Foundations/Data/List/IsChainFromTo.lean

@@ -0,0 +1,194 @@
+/-
+Copyright (c) 2026 Christian Reitwiessner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Christian Reitwiessner
+-/
+
+module
+
+public import Cslib.Init
+public import Mathlib.Data.List.Chain
+public import Mathlib.Data.List.Nodup
+public import Mathlib.Logic.Relation
+
+/-! # Chains with a designated start and end
+
+This file defines `List.IsChainFromTo`, a variant of `List.IsChain` that also fixes the first and
+last element of the chain. Such a chain is an explicit witness for the fact that its end point is
+reachable from its start point, and its length bounds the number of steps that are needed.
+
+## Main definitions
+
+* `List.IsChainFromTo r chain a b`: `chain` is a non-empty list whose adjacent elements are related
+  by `r`, whose first element is `a` and whose last element is `b`.
+
+## Main results
+
+* `List.IsChainFromTo.reflTransGen`: the start and the end of a chain are related by
+  `Relation.ReflTransGen`.
+* `List.IsChainFromTo.head_induction_on`: induction on a chain, peeling off elements at the start.
+* `List.IsChainFromTo.exists_length_lt_of_not_nodup`: a chain with duplicates can always be
+  shortened.
+* `List.IsChainFromTo.exists_nodup`: iterating the above yields a chain without duplicates.
+-/
+
+@[expose] public section
+
+variable {α : Type*} {r : α → α → Prop} {chain : List α} {a b c : α}
+
+/-- A "chain from to" is a list of elements where adjacent elements relate to each other
+(cf. `List.IsChain`) and start and end with specific elements. -/
+structure List.IsChainFromTo {α : Type*} (r : α → α → Prop) (chain : List α) (a b : α) : Prop where
+  isChain : chain.IsChain r
+  ne_nil : chain ≠ []
+  head_eq : chain.head ne_nil = a
+  getLast_eq : chain.getLast ne_nil = b
+
+attribute [grind →] List.IsChainFromTo.head_eq List.IsChainFromTo.getLast_eq
+
+/-- A chain has at least one element. -/
+@[grind →]
+lemma List.IsChainFromTo.length_pos (hc : chain.IsChainFromTo r a b) : 0 < chain.length :=
+  List.length_pos_iff.mpr hc.ne_nil
+
+/-- The first element of an `r`-chain from `a` to `b` is `a`. -/
+@[grind →]
+lemma List.IsChainFromTo.getElem_zero (hc : chain.IsChainFromTo r a b) :
+    chain[0]'hc.length_pos = a := by
+  rw [List.getElem_zero]
+  exact hc.head_eq
+
+/-- The last element of an `r`-chain from `a` to `b` is `b`. -/
+@[grind →]
+lemma List.IsChainFromTo.getElem_length_sub_one (hc : chain.IsChainFromTo r a b) :
+    chain[chain.length - 1]'(by have := hc.length_pos; lia) = b := by
+  rw [List.getElem_length_sub_one_eq_getLast]
+  exact hc.getLast_eq
+
+/-- The start and the end of an `r`-chain are reflexively-transitively related by `r`. -/
+theorem List.IsChainFromTo.reflTransGen (hc : chain.IsChainFromTo r a b) :
+    Relation.ReflTransGen r a b := by
+  simpa [hc.head_eq, hc.getLast_eq] using
+    List.relationReflTransGen_of_exists_isChain chain hc.isChain hc.ne_nil
+
+/-- Create a `List.IsChainFromTo` from a non-empty `List.IsChain`. -/
+theorem List.IsChain.isChainFromTo_of_ne_nil
+    {chain : List α} (hc : chain.IsChain r) (h_ne_nil : chain ≠ []) :
+    List.IsChainFromTo r chain (chain.head h_ne_nil) (chain.getLast h_ne_nil) :=
+  ⟨hc, h_ne_nil, rfl, rfl⟩
+
+/-- A one-element list is an `r`-chain from that element to itself. -/
+@[simp, grind ←]
+lemma List.isChainFromTo_singleton : List.IsChainFromTo r [a] a a :=
+  ⟨List.IsChain.singleton a, by simp, rfl, rfl⟩
+
+/-- Prepend an `r`-related element to the start of the chain. -/
+lemma List.IsChainFromTo.cons (h : r a b) (hc : chain.IsChainFromTo r b c) :
+    (a :: chain).IsChainFromTo r a c where
+  isChain := hc.isChain.cons_of_ne_nil hc.ne_nil (hc.head_eq.symm ▸ h)
+  ne_nil := cons_ne_nil a chain
+  head_eq := head_cons
+  getLast_eq := hc.getLast_eq ▸ chain.getLast_cons hc.ne_nil
+
+/-- A two-element list of `r`-related elements is an `r`-chain from the first to the second. -/
+@[simp, grind ←]
+lemma List.isChainFromTo_pair (h : r a b) : List.IsChainFromTo r [a, b] a b :=
+  ⟨by simp [h], by simp, rfl, rfl⟩
+
+/-- Removing the head yields a valid chain. -/
+lemma List.IsChainFromTo.of_cons_cons {x y : α} (hc : (x :: y :: chain).IsChainFromTo r a b) :
+    (y :: chain).IsChainFromTo r y b :=
+  ⟨hc.isChain.of_cons, cons_ne_nil _ _, head_cons, by grind⟩
+
+/-- Appending a chain and the tail of a second one whose start point equals the end point of the
+first yields a valid chain. -/
+lemma List.IsChainFromTo.append_tail (hc : chain.IsChainFromTo r a b) {chain' : List α}
+    (hc' : chain'.IsChainFromTo r b c) : (chain ++ chain'.tail).IsChainFromTo r a c where
+  isChain := by
+    have hb : chain.dropLast ++ [b] = chain :=
+      hc.getLast_eq ▸ chain.dropLast_append_getLast hc.ne_nil
+    have hb' : [b] ++ chain'.tail = chain' := by simp [←hc'.head_eq]
+    rw [←hb] at hc ⊢
+    exact hc.isChain.append_overlap (l₃ := chain'.tail) (hb'.symm ▸ hc'.isChain) (cons_ne_nil b [])
+  ne_nil := append_ne_nil_of_left_ne_nil hc.ne_nil _
+  head_eq := head_append_left hc.ne_nil |>.trans hc.head_eq
+  getLast_eq := by grind
+
+/-- Add an `r`-related element to the end of the chain. -/
+lemma List.IsChainFromTo.snoc (hc : chain.IsChainFromTo r a b) (h : r b c) :
+    (chain ++ [c]).IsChainFromTo r a c :=
+  append_tail hc (chain' := [b, c]) (by simp [h])
+
+/-- Appending a chain, dropping its last element and another chain whose start point equals
+the end point of the first chain yields a valid chain. -/
+lemma List.IsChainFromTo.append_dropLast (hc : chain.IsChainFromTo r a b) {chain' : List α}
+    (hc' : chain'.IsChainFromTo r b c) : (chain.dropLast ++ chain').IsChainFromTo r a c := by
+  convert hc.append_tail hc' using 1
+  nth_rw 1 [←chain'.cons_head_tail hc'.ne_nil, hc'.head_eq, append_cons, ←hc.getLast_eq,
+    dropLast_concat_getLast hc.ne_nil]
+
+/-- Taking the first `i + 1` elements of a chain yields a chain from the same start point to
+`chain[i]`. -/
+lemma List.IsChainFromTo.take (hc : chain.IsChainFromTo r a b) {i : ℕ} (hi : i < chain.length) :
+    (chain.take (i + 1)).IsChainFromTo r a chain[i] := by
+  have : chain.take (i + 1) ≠ [] := by grind [ne_nil_iff_length_pos, length_take]
+  exact ⟨hc.isChain.take _, this, by grind, by grind [chain.getLast_take this]⟩
+
+/-- Dropping the first `i` elements of a chain yields a chain from `chain[i]` to the same end
+point. -/
+lemma List.IsChainFromTo.drop (hc : chain.IsChainFromTo r a b) {i : ℕ} (hi : i < chain.length) :
+    (chain.drop i).IsChainFromTo r chain[i] b := by
+  have : chain.drop i ≠ [] := ne_nil_iff_length_pos.mpr <| chain.lt_length_drop hi
+  refine ⟨hc.isChain.drop _, this, chain.head_drop this, hc.getLast_eq ▸ chain.getLast_drop this⟩
+
+@[elab_as_elim]
+lemma List.IsChainFromTo.head_induction_on
+    {motive : ∀ {chain : List α} {a b : α}, chain.IsChainFromTo r a b → Prop}
+    (h_refl : ∀ {a : α}, motive (isChainFromTo_singleton (r := r) (a := a)))
+    (h_head : ∀ {a b c : α} {chain : List α} (hab : r a b) (hc : chain.IsChainFromTo r b c),
+      motive hc → motive (hc.cons hab))
+    {chain : List α} {a b : α} (hc : chain.IsChainFromTo r a b) : motive hc := by
+  induction htail : chain.tail generalizing chain a with
+  | nil =>
+    obtain rfl : chain = [a] := by grind
+    grind
+  | cons a' tail ih =>
+    obtain rfl : chain = a :: a' :: tail := by grind
+    obtain ⟨hrel, hchain⟩ := isChain_cons_cons.mp hc.isChain
+    have : (a' :: tail).IsChainFromTo r a' b := hc.of_cons_cons
+    exact h_head hrel this (ih this rfl)
+
+/-- Any element of an `r`-chain from `a` to `b` is reflexively-transitively related from `a`. -/
+lemma List.IsChainFromTo.reflTransGen_of_mem (hc : chain.IsChainFromTo r a b) {x : α}
+    (mem : x ∈ chain) :
+    Relation.ReflTransGen r a x := by
+  obtain ⟨i, hi, rfl⟩ := List.getElem_of_mem mem
+  exact (hc.take hi).reflTransGen
+
+/-- If there is an `r`-chain from `a` to `b` with duplicates, then there is a shorter `r`-chain
+from `a` to `b` (the one that skips the part between the duplicates). -/
+lemma List.IsChainFromTo.exists_length_lt_of_not_nodup
+    (hc : chain.IsChainFromTo r a b)
+    (h_dup : ¬ chain.Nodup) :
+    ∃ chain' : List α, chain'.IsChainFromTo r a b ∧ chain'.length < chain.length := by
+  simp only [nodup_iff_getElem?_ne_getElem?, not_forall, not_not] at h_dup
+  obtain ⟨i, j, h_ij, h_lt, h_eq⟩ := h_dup
+  use chain.take i ++ chain.drop j
+  split_ands
+  · apply IsChainFromTo.mk ..
+    · apply (hc.isChain.take _).append (hc.isChain.drop _)
+      grind [List.head?_drop, hc.isChain.getElem (i := i - 1)]
+    · grind [append_eq_nil_iff, drop_eq_nil_iff]
+    · grind
+    · grind
+  · grind
+
+/-- For any `r`-chain from `a` to `b` there is one without duplicates. -/
+lemma List.IsChainFromTo.exists_nodup (hc : chain.IsChainFromTo r a b) :
+    ∃ chain' : List α, chain'.IsChainFromTo r a b ∧ chain'.Nodup := by
+  induction hn : chain.length using Nat.strong_induction_on generalizing chain with
+  | h n ih =>
+    by_cases h_dup : chain.Nodup
+    · use chain, hc, h_dup
+    · obtain ⟨chain', hc', hlen⟩ := hc.exists_length_lt_of_not_nodup h_dup
+      exact ih chain'.length (hn ▸ hlen) hc' rfl

Cslib/Foundations/Data/RelatesInSteps.lean

@@ -7,18 +7,28 @@ Authors: Bolton Bailey
 module
 
 public import Cslib.Init
+public import Cslib.Foundations.Data.List.IsChainFromTo
+public import Mathlib.Data.Set.Card
 public import Mathlib.Logic.Relation
 
 /-! # Relations Across Steps
 
 This file defines `Relation.RelatesInSteps` (and `Relation.RelatesWithinSteps`).
-These are inductively defines propositions that communicate whether a relation forms a
+These are inductively defined propositions that communicate whether a relation forms a
 chain of length `n` (or at most `n`) between two elements.
+
+The lemma `RelatesInSteps.exists_isChainFromTo` allows to obtain a chain
+(`List.IsChainFromTo`) of related elements that witness the reachability, and
+`List.IsChainFromTo.relatesInSteps` is the converse direction.
+`Relation.relatesInSteps_iff_exists_isChainFromTo` combines both.
+
+Another result is `Relation.ReflTransGen.relatesInSteps_lt_encard`, which states that any element
+reachable from `a` is reachable in fewer steps than there are elements reachable from `a`.
 -/
 
 @[expose] public section
 
-variable {α : Type*} {r : α → α → Prop} {a b c : α}
+variable {α : Type*} {r : α → α → Prop} {a b c : α} {n m : ℕ}
 
 namespace Relation
 
@@ -37,6 +47,8 @@ theorem RelatesInSteps.reflTransGen (h : RelatesInSteps r a b n) : ReflTransGen
   | refl => rfl
   | tail _ _ _ _ h ih => exact .tail ih h
 
+/-- If `b` is reachable from `a` via `r`, then they relate to each other for some number
+of steps. -/
 theorem ReflTransGen.relatesInSteps (h : ReflTransGen r a b) : ∃ n, RelatesInSteps r a b n := by
   induction h with
   | refl => exact ⟨0, .refl a⟩
@@ -100,9 +112,8 @@ lemma RelatesInSteps.succ_iff {a b : α} {n : ℕ} :
   · rintro ⟨t', h_steps, h_red⟩
     exact .tail _ t' b n h_steps h_red
 
-lemma RelatesInSteps.succ' {a b : α} : ∀ {n : ℕ}, RelatesInSteps r a b (n + 1) →
+lemma RelatesInSteps.succ' {a b : α} {n : ℕ} (h : RelatesInSteps r a b (n + 1)) :
     ∃ t', r a t' ∧ RelatesInSteps r t' b n := by
-  intro n h
   obtain ⟨t', hsteps, hstep⟩ := succ h
   cases n with
   | zero =>
@@ -147,6 +158,50 @@ lemma RelatesInSteps.map {α α' : Type*}
   | tail t' t'' m _ hstep ih =>
     exact .tail (g _) (g t') (g t'') m ih (hg t' t'' hstep)
 
+/-! ## Translating between `RelatesInSteps` and chains (`List.IsChainFromTo`) -/
+
+/-- If `b` is related to `a` via `r` in `n` steps, then there is an `r`-chain of `n + 1` elements
+starting at `a` and ending at `b`.
+This is similar to `List.exists_isChain_ne_nil_of_relationReflTransGen`, but also provides
+a length guarantee. -/
+lemma RelatesInSteps.exists_isChainFromTo {a b : α} {n : ℕ} (h : RelatesInSteps r a b n) :
+    ∃ chain : List α, chain.IsChainFromTo r a b ∧ chain.length = n + 1 := by
+  induction h using RelatesInSteps.head_induction_on with
+  | hrefl => exact ⟨[b], List.isChainFromTo_singleton, rfl⟩
+  | @hhead a c n h' h ih =>
+    obtain ⟨l, hchain, hlen⟩ := ih
+    use a :: l, hchain.cons h'
+    simpa
+
+/-- Any two elements along an `r`-chain are related in as many steps as their distance in the
+chain. -/
+lemma _root_.List.IsChain.relatesInSteps_getElem {chain : List α} (hc : chain.IsChain r)
+    (i k : ℕ) (hik : i + k < chain.length) :
+    RelatesInSteps r chain[i] chain[i + k] k := by
+  induction k with
+  | zero => exact .refl _
+  | succ k ih =>
+    apply RelatesInSteps.tail _ (chain[i + k]) _ k (ih (by lia))
+    apply List.IsChain.getElem hc
+
+/-- If there is an `r`-chain of `n + 1` elements from `a` to `b`, then `a` and `b` are related
+to each other in `n` steps. -/
+lemma _root_.List.IsChainFromTo.relatesInSteps {chain : List α} {n : ℕ}
+    (hc : chain.IsChainFromTo r a b) (hlen : chain.length = n + 1) :
+    RelatesInSteps r a b n := by
+  have hrel := _root_.List.IsChain.relatesInSteps_getElem hc.isChain 0 n (by lia)
+  simp only [Nat.zero_add] at hrel
+  have hlast : chain[n]'(by lia) = b := by simpa [hlen] using hc.getElem_length_sub_one
+  rwa [hc.getElem_zero, hlast] at hrel
+
+/-- `a` and `b` are related in `n` steps exactly when there is an `r`-chain of `n + 1` elements
+from `a` to `b`. -/
+lemma relatesInSteps_iff_exists_isChainFromTo :
+    RelatesInSteps r a b n ↔ ∃ chain : List α, chain.IsChainFromTo r a b ∧ chain.length = n + 1 :=
+  ⟨RelatesInSteps.exists_isChainFromTo, fun ⟨_, hc, hlen⟩ => hc.relatesInSteps hlen⟩
+
+/-! ## RelatesWithinSteps - only requires an upper bound on the number of steps -/
+
 /--
 `RelatesWithinSteps` is a variant of `RelatesInSteps` that allows for a loose bound.
 It states that `a` relates to `b` in *at most* `n` steps.
@@ -166,10 +221,8 @@ lemma RelatesWithinSteps.single {a b : α} (h : r a b) : RelatesWithinSteps r a
   RelatesWithinSteps.of_relatesInSteps (RelatesInSteps.single h)
 
 lemma RelatesWithinSteps.zero {a b : α} (h : RelatesWithinSteps r a b 0) : a = b := by
-  obtain ⟨m, hm, hevals⟩ := h
-  have : m = 0 := Nat.le_zero.mp hm
-  subst this
-  exact RelatesInSteps.zero hevals
+  obtain ⟨_, hm, hevals⟩ := h
+  simp_all
 
 @[simp]
 lemma RelatesWithinSteps.zero_iff {a b : α} : RelatesWithinSteps r a b 0 ↔ a = b := by
@@ -186,22 +239,20 @@ lemma RelatesWithinSteps.trans {a b c : α} {n₁ n₂ : ℕ}
     RelatesWithinSteps r a c (n₁ + n₂) := by
   obtain ⟨m₁, hm₁, hevals₁⟩ := h₁
   obtain ⟨m₂, hm₂, hevals₂⟩ := h₂
-  use m₁ + m₂
-  constructor
-  · lia
-  · exact RelatesInSteps.trans hevals₁ hevals₂
+  exact ⟨m₁ + m₂, by lia, hevals₁.trans hevals₂⟩
 
-lemma RelatesWithinSteps.of_le {a b : α} {n₁ n₂ : ℕ}
-    (h : RelatesWithinSteps r a b n₁) (hn : n₁ ≤ n₂) :
-    RelatesWithinSteps r a b n₂ := by
-  obtain ⟨m, hm, hevals⟩ := h
+/-- If two elements `a` and `b` are related in at most `n₁` steps in the relation `r` and
+`n₁ ≤ n₂`, then they are also related in at most `n₂` steps. -/
+lemma RelatesWithinSteps.mono {a b : α} : Monotone (RelatesWithinSteps r a b ·) := by
+  intro n₁ n₂ hn ⟨m, hm, hevals⟩
   exact ⟨m, Nat.le_trans hm hn, hevals⟩
 
 /-- If `h : α → ℕ` increases by at most 1 on each step of `r`,
 then the value of `h` at the output is at most `h` at the input plus the step bound. -/
-lemma RelatesWithinSteps.apply_le_apply_add {a b : α} {m : ℕ} (hevals : RelatesWithinSteps r a b m)
-    (h : α → ℕ) (h_step : ∀ a b, r a b → h b ≤ h a + 1)
-    :
+lemma RelatesWithinSteps.apply_le_apply_add {a b : α} {m : ℕ}
+    (hevals : RelatesWithinSteps r a b m)
+    (h : α → ℕ)
+    (h_step : ∀ a b, r a b → h b ≤ h a + 1) :
     h b ≤ h a + m := by
   obtain ⟨m, hm, hevals_m⟩ := hevals
   have := RelatesInSteps.apply_le_apply_add hevals_m h h_step
@@ -218,4 +269,29 @@ lemma RelatesWithinSteps.map {α α' : Type*} {r : α → α → Prop} {r' : α'
   obtain ⟨m, hm, hevals⟩ := h
   exact ⟨m, hm, RelatesInSteps.map g hg hevals⟩
 
+/-! ## Reachability under a bound on the number of reachable elements -/
+
+/-- A more precise version of `ReflTransGen.relatesInSteps`: if `b` is reachable from `a`, then it
+is related to `a` in fewer steps than there are elements reachable from `a`.
+Note that this cardinality is an `ℕ∞`, and if it is infinite, no bound on the number of steps
+is stated. -/
+theorem ReflTransGen.relatesInSteps_lt_encard {b : α} (h : ReflTransGen r a b) :
+    ∃ n, RelatesInSteps r a b n ∧ (n : ℕ∞) < {x | ReflTransGen r a x}.encard := by
+  classical
+  -- Take any chain from `a` to `b` and remove its duplicates.
+  obtain ⟨n₀, hn₀⟩ := h.relatesInSteps
+  obtain ⟨chain₀, hc₀, -⟩ := hn₀.exists_isChainFromTo
+  obtain ⟨chain, hc, h_nodup⟩ := hc₀.exists_nodup
+  obtain ⟨n, hlen⟩ : ∃ n, chain.length = n + 1 := ⟨chain.length - 1, by have := hc.length_pos; lia⟩
+  refine ⟨n, hc.relatesInSteps hlen, ?_⟩
+  -- All elements of the chain are reachable from `a`, and they are pairwise distinct,
+  -- so the chain has at most as many elements as there are reachable elements.
+  have hsub : {x | x ∈ chain} ⊆ {x | ReflTransGen r a x} := fun _ hx => hc.reflTransGen_of_mem hx
+  have h_le : (chain.length : ℕ∞) ≤ {x | ReflTransGen r a x}.encard := by
+    rw [← List.coe_toFinset] at hsub
+    have := Set.encard_le_encard hsub
+    rwa [Set.encard_coe_eq_coe_finsetCard, List.toFinset_card_of_nodup h_nodup] at this
+  -- The chain has one more element than the number of steps.
+  exact lt_of_lt_of_le (by rw [hlen]; exact_mod_cast Nat.lt_succ_self n) h_le
+
 end Relation