Make FiniteHeightLattice extend Lattice and derive Top/Bot

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lean/Spa/Lattice/AboveBelow.lean

@@ -223,17 +223,11 @@ lemma boundedChains : BoundedChains (AboveBelow α) 2 := fun c => by
   omega
 
 instance [Inhabited α] : FiniteHeightLattice (AboveBelow α) where
-  bot := bot
-  top := top
-  height := 2
+  toLattice := inferInstance
   longestChain :=
-    { series :=
-        ((RelSeries.singleton _ bot).snoc (mk default)
-            (by rw [RelSeries.last_singleton]; exact bot_lt_mk default)).snoc top
-          (by rw [RelSeries.last_snoc]; exact mk_lt_top default)
-      head_series := by simp
-      last_series := by simp
-      length_series := by simp [RelSeries.snoc, RelSeries.append] }
+    ((RelSeries.singleton _ bot).snoc (mk default)
+        (by rw [RelSeries.last_singleton]; exact bot_lt_mk default)).snoc top
+      (by rw [RelSeries.last_snoc]; exact mk_lt_top default)
   chains_bounded := boundedChains
 
 end AboveBelow

lean/Spa/Lattice/Bool.lean

@@ -28,13 +28,9 @@ lemma boundedChains : BoundedChains Bool 1 := fun c => by
   omega
 
 instance : FiniteHeightLattice Bool where
-  height := 1
-  longestChain :=
-    { series := (RelSeries.singleton _ (⊥ : Bool)).snoc (⊤ : Bool)
-        (by rw [RelSeries.last_singleton]; exact bot_lt_top)
-      head_series := by simp
-      last_series := by simp
-      length_series := by simp [RelSeries.snoc, RelSeries.append] }
+  toLattice := inferInstance
+  longestChain := (RelSeries.singleton _ (⊥ : Bool)).snoc (⊤ : Bool)
+    (by rw [RelSeries.last_singleton]; exact bot_lt_top)
   chains_bounded := boundedChains
 
 end Bool

lean/Spa/Lattice/FiniteMap.lean

@@ -12,7 +12,7 @@ variable {A B : Type*} {ks : List A}
 instance [Lattice B] : Lattice (FiniteMap A B ks) :=
   inferInstanceAs (Lattice (Fin ks.length → B))
 
-instance [Lattice B] [FiniteHeightLattice B] : FiniteHeightLattice (FiniteMap A B ks) :=
+instance [FiniteHeightLattice B] : FiniteHeightLattice (FiniteMap A B ks) :=
   inferInstanceAs (FiniteHeightLattice (Fin ks.length → B))
 
 instance [DecidableEq B] : DecidableEq (FiniteMap A B ks) :=

lean/Spa/Lattice/IterProd.lean

@@ -13,11 +13,6 @@ namespace IterProd
 
 variable {A B : Type u}
 
-instance lattice [Lattice A] [Lattice B] :
-    ∀ k, Lattice (IterProd A B k)
-  | 0 => inferInstanceAs (Lattice B)
-  | k + 1 => @Prod.instLattice A (IterProd A B k) _ (lattice k)
-
 instance decidableEq [DecidableEq A] [DecidableEq B] :
     ∀ k, DecidableEq (IterProd A B k)
   | 0 => inferInstanceAs (DecidableEq B)
@@ -27,24 +22,14 @@ def build (a : A) (b : B) : (k : ℕ) → IterProd A B k
   | 0 => b
   | k + 1 => (a, build a b k)
 
-variable [Lattice A] [Lattice B]
-
 def fixedHeight [FiniteHeightLattice A] [FiniteHeightLattice B] :
     ∀ k, FiniteHeightLattice (IterProd A B k)
   | 0 => inferInstanceAs (FiniteHeightLattice B)
-  | k + 1 => @Spa.prod A (IterProd A B k) _ (lattice k) _ (fixedHeight k)
+  | k + 1 => @Spa.prod A (IterProd A B k) _ (fixedHeight k)
 
 instance finiteHeight [FiniteHeightLattice A] [FiniteHeightLattice B] (k : ℕ) :
     FiniteHeightLattice (IterProd A B k) := fixedHeight k
 
-lemma bot_fixedHeight [FiniteHeightLattice A] [FiniteHeightLattice B] :
-    ∀ k, (fixedHeight (A := A) (B := B) k).bot = build (⊥ : A) (⊥ : B) k
-  | 0 => rfl
-  | k + 1 => by
-    show ((⊥ : A), (fixedHeight (A := A) (B := B) k).bot)
-        = ((⊥ : A), build (⊥ : A) (⊥ : B) k)
-    rw [bot_fixedHeight k]
-
 end IterProd
 
 end Spa

lean/Spa/Lattice/Prod.lean

@@ -58,36 +58,23 @@ end Unzip
 
 section FixedHeight
 
-variable {α β : Type*} [Lattice α] [Lattice β]
+variable {α β : Type*}
 
 instance prod [A : FiniteHeightLattice α] [B : FiniteHeightLattice β] :
     FiniteHeightLattice (α × β) where
-  bot := ((⊥ : α), (⊥ : β))
-  top := ((⊤ : α), (⊤ : β))
-  height := A.height + B.height
+  toLattice := inferInstance
   longestChain :=
-    { series :=
-        RelSeries.smash
-          (A.longestChain.series.map (fun a => (a, (⊥ : β)))
-            (fun _ _ h => Prod.mk_lt_mk_iff_left.mpr h))
-          (B.longestChain.series.map (fun b => ((⊤ : α), b))
-            (fun _ _ h => Prod.mk_lt_mk_iff_right.mpr h))
-          (by simp [A.longestChain.last_series, B.longestChain.head_series])
-      head_series :=
-        (RelSeries.head_smash _).trans
-          ((LTSeries.head_map _ _ _).trans
-            (congrArg (·, (⊥ : β)) A.longestChain.head_series))
-      last_series :=
-        (RelSeries.last_smash _).trans
-          ((LTSeries.last_map _ _ _).trans
-            (congrArg ((⊤ : α), ·) B.longestChain.last_series))
-      length_series := by
-        show A.longestChain.series.length + B.longestChain.series.length = _
-        rw [A.longestChain.length_series, B.longestChain.length_series] }
+    RelSeries.smash
+      (A.longestChain.map (fun a => (a, (⊥ : β)))
+        (fun _ _ h => Prod.mk_lt_mk_iff_left.mpr h))
+      (B.longestChain.map (fun b => ((⊤ : α), b))
+        (fun _ _ h => Prod.mk_lt_mk_iff_right.mpr h))
+      rfl
   chains_bounded := fun c => by
     obtain ⟨c₁, c₂, -, -, -, -, hlen⟩ := LTSeries.exists_unzip c
     have h₁ := A.chains_bounded c₁
     have h₂ := B.chains_bounded c₂
+    show c.length ≤ A.longestChain.length + B.longestChain.length
     omega
 
 end FixedHeight

lean/Spa/Lattice/Tuple.lean

@@ -32,7 +32,7 @@ private lemma iterOfFun_funOfIter : ∀ {n : ℕ} (ip : IterProd B PUnit n),
     rw [show funOfIter ip = Fin.cons ip.1 (funOfIter ip.2) from rfl]
     simp [Fin.cons_zero, Fin.tail_cons, iterOfFun_funOfIter ip.2]
 
-variable [Lattice B]
+variable [FiniteHeightLattice B]
 
 private lemma funOfIter_mono {n : ℕ} :
     Monotone (funOfIter : IterProd B PUnit n → (Fin n → B)) := by
@@ -55,7 +55,7 @@ private lemma iterOfFun_mono {n : ℕ} :
     intro f g h
     exact Prod.le_def.mpr ⟨h 0, ih fun i => h i.succ⟩
 
-instance instFiniteHeight {n : ℕ} [FiniteHeightLattice B] :
+instance instFiniteHeight {n : ℕ} :
     FiniteHeightLattice (Fin n → B) :=
   FiniteHeightLattice.transport funOfIter iterOfFun
     funOfIter_mono iterOfFun_mono iterOfFun_funOfIter funOfIter_iterOfFun

lean/Spa/Lattice/Unit.lean

@@ -9,14 +9,8 @@ lemma boundedChains_of_subsingleton (α : Type*) [Preorder α] [Subsingleton α]
   exact (c.step ⟨0, by omega⟩).ne (Subsingleton.elim _ _)
 
 instance : FiniteHeightLattice PUnit where
-  bot := PUnit.unit
-  top := PUnit.unit
-  height := 0
-  longestChain :=
-    { series := RelSeries.singleton _ PUnit.unit
-      head_series := rfl
-      last_series := rfl
-      length_series := rfl }
+  toLattice := inferInstance
+  longestChain := RelSeries.singleton _ PUnit.unit
   chains_bounded := boundedChains_of_subsingleton PUnit 0
 
 end Spa