Usw OrderBot / OrderTop for lattice witnesses

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
Co-Authored-By: OpenAI Codex <codex@openai.com>

lean/Spa/Lattice.lean

@@ -76,7 +76,7 @@ lemma boundedChains_of_subsingleton (α : Type*) [Preorder α] [Subsingleton α]
   exact (c.step ⟨0, by omega⟩).ne (Subsingleton.elim _ _)
 
 /-- A finite height lattice is a lattice in which all chains $a < \ldots < z$ have a maximum height `height`. -/
-class FiniteHeightLattice (α : Type*) extends Lattice α where
+class FiniteHeightLattice (α : Type*) extends Lattice α, OrderBot α, OrderTop α where
   longestChain : LTSeries α
   chains_bounded : BoundedChains α longestChain.length
 
@@ -90,30 +90,19 @@ def height (α : Type*) [FiniteHeightLattice α] : ℕ :=
 
 variable (α : Type*) [FiniteHeightLattice α]
 
-instance (priority := 100) : Bot α := ⟨(longestChain (α := α)).head⟩
-instance (priority := 100) : Top α := ⟨(longestChain (α := α)).last⟩
+/-- Any maximum-length chain in a bounded finite-height lattice starts at `⊥`. -/
+lemma longestChain_head : (longestChain (α := α)).head = ⊥ := by
+  by_contra hne
+  have hbound := chains_bounded ((longestChain (α := α)).cons ⊥ (bot_lt_iff_ne_bot.mpr hne))
+  rw [RelSeries.cons_length] at hbound
+  omega
 
-/-- The bottom element `⊥` of a finite height lattice is _actually_ the least element. -/
-lemma bot_le (a : α) : (⊥ : α) ≤ a := by
-  by_cases heq : ⊥ ⊓ a = ⊥
-  · exact inf_eq_left.mp heq
-  · exfalso
-    have hlt : ⊥ ⊓ a < (longestChain (α := α)).head :=
-      lt_of_le_of_ne inf_le_left heq
-    have hbound := chains_bounded ((longestChain (α := α)).cons (⊥ ⊓ a) hlt)
-    rw [RelSeries.cons_length] at hbound
-    omega
-
-/-- The top element `⊤` of a finite height lattice is _actually_ the greatest element. -/
-lemma le_top (a : α) : a ≤ (⊤ : α) := by
-  by_cases heq : a ⊔ ⊤ = ⊤
-  · exact sup_eq_right.mp heq
-  · exfalso
-    have hlt : (longestChain (α := α)).last < a ⊔ ⊤ :=
-      lt_of_le_of_ne le_sup_right (Ne.symm heq)
-    have hbound := chains_bounded ((longestChain (α := α)).snoc (a ⊔ ⊤) hlt)
-    rw [RelSeries.snoc_length] at hbound
-    omega
+/-- Any maximum-length chain in a bounded finite-height lattice ends at `⊤`. -/
+lemma longestChain_last : (longestChain (α := α)).last = ⊤ := by
+  by_contra hne
+  have hbound := chains_bounded ((longestChain (α := α)).snoc ⊤ (lt_top_iff_ne_top.mpr hne))
+  rw [RelSeries.snoc_length] at hbound
+  omega
 
 /-- This is something like a lemma about isomorphic types having the same height.
     Given a finite-height lattice `α`, lattice `β`, and a `Monotone` bijection
@@ -129,6 +118,16 @@ def transport {α β : Type*} [Lattice β]
     (hgf : Function.LeftInverse g f) (hfg : Function.LeftInverse f g) :
     FiniteHeightLattice β where
   toLattice := inferInstance
+  toOrderBot := {
+    bot := f (⊥ : α)
+    bot_le := fun b => by
+      rw [← hfg b]
+      exact hf (_root_.bot_le : (⊥ : α) ≤ g b) }
+  toOrderTop := {
+    top := f (⊤ : α)
+    le_top := fun b => by
+      rw [← hfg b]
+      exact hf (_root_.le_top : g b ≤ (⊤ : α)) }
   longestChain :=
     I.longestChain.map f (hf.strictMono_of_injective hgf.injective)
   chains_bounded := fun c =>
@@ -136,8 +135,15 @@ def transport {α β : Type*} [Lattice β]
 
 /-- A `Unique` lattice trivially has finite height: its only chain is the singleton
     `[default]`, and there are no nontrivial `<` chains in a subsingleton. -/
-def ofUnique (α : Type*) [Lattice α] [Unique α] : FiniteHeightLattice α where
+def ofUnique (α : Type*) [Lattice α] [Unique α] :
+    FiniteHeightLattice α where
   toLattice := inferInstance
+  toOrderBot := {
+    bot := default
+    bot_le := fun _ => le_of_eq (Subsingleton.elim _ _) }
+  toOrderTop := {
+    top := default
+    le_top := fun _ => le_of_eq (Subsingleton.elim _ _) }
   longestChain := RelSeries.singleton _ default
   chains_bounded := boundedChains_of_subsingleton α 0