Danila Fedorin
2ee32580a2
The fable-based migration left a two-layer design (a standalone `FixedHeight α h` struct, height carried as a type index, plus a `FiniteHeightLattice` wrapper). This collapses it to the single `FiniteHeightLattice` typeclass (height as a plain field, `⊥`/`⊤` via `extends Bot`/`Top`), and fixes the fallout so the whole project builds again (`lake build` green). - Lattice: repair `FixedHeight.bot_le` (compute the `▸` motive via a forward `rw`, drop the leftover `fh.length_longestChain`) and the `bot_le` alias. - Isomorphism: transport rewritten directly onto `FiniteHeightLattice`, taking the source as an instance argument. - Lattice/Prod, AboveBelow: `FixedHeight`-producing def + wrapper instance collapsed into one `FiniteHeightLattice` instance. `head`/`last` proofs use term-mode `congrArg` to bridge the `Bot`/`Top` defeq through the under-construction instance projection (where `rw`+`rfl` cannot). - Lattice/IterProd: `fixedHeight` recursion now yields a `FiniteHeightLattice` (no height index, so the `.cast (by ring)` reassociations vanish); `bot_fixedHeight` reprojected onto the def's own `.bot`. - Lattice/FiniteMap: `fixedHeight`/`bot_contains_bots` go through transport with the IterProd instance resolved by typeclass search; `punitFixedHeight` replaced by the `PUnit` instance. - Analysis/Forward/Lattices: `botV` uses `⊥` instead of the deleted `FiniteHeightLattice.bot` accessor. - Analysis/Sign: `num` case used unimported `ring`; the goal is a pure ℕ→ℤ cast identity, closed with `norm_cast`. Also fixes the missing `show` in `AboveBelow.monotone₂_of_strict` that left un-beta-reduced redexes. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
96 lines
3.0 KiB
Lean4
96 lines
3.0 KiB
Lean4
import Mathlib.Order.Lattice
|
||
import Mathlib.Order.RelSeries
|
||
|
||
namespace Spa
|
||
|
||
def Monotone₂ {α β γ : Type*} [Preorder α] [Preorder β] [Preorder γ]
|
||
(f : α → β → γ) : Prop :=
|
||
(∀ b, Monotone (f · b)) ∧ (∀ a, Monotone (f a ·))
|
||
|
||
section Folds
|
||
|
||
variable {α β : Type*} [Preorder α] [Preorder β]
|
||
|
||
theorem foldr_mono {l₁ l₂ : List α} (f : α → β → β) {b₁ b₂ : β}
|
||
(hl : List.Forall₂ (· ≤ ·) l₁ l₂) (hb : b₁ ≤ b₂)
|
||
(hf₁ : ∀ b, Monotone fun a => f a b) (hf₂ : ∀ a, Monotone (f a)) :
|
||
l₁.foldr f b₁ ≤ l₂.foldr f b₂ := by
|
||
induction hl with
|
||
| nil => exact hb
|
||
| cons hxy _ ih =>
|
||
exact le_trans (hf₁ _ hxy) (hf₂ _ ih)
|
||
|
||
theorem foldl_mono {l₁ l₂ : List α} (f : β → α → β) {b₁ b₂ : β}
|
||
(hl : List.Forall₂ (· ≤ ·) l₁ l₂) (hb : b₁ ≤ b₂)
|
||
(hf₁ : ∀ a, Monotone fun b => f b a) (hf₂ : ∀ b, Monotone (f b)) :
|
||
l₁.foldl f b₁ ≤ l₂.foldl f b₂ := by
|
||
induction hl generalizing b₁ b₂ with
|
||
| nil => exact hb
|
||
| cons hxy _ ih =>
|
||
exact ih (le_trans (hf₁ _ hb) (hf₂ _ hxy))
|
||
|
||
omit [Preorder α] in
|
||
theorem foldr_mono' (l : List α) (f : α → β → β)
|
||
(hf : ∀ a, Monotone (f a ·)) : Monotone fun b => l.foldr f b := by
|
||
intro b₁ b₂ hb
|
||
induction l with
|
||
| nil => exact hb
|
||
| cons x xs ih => exact hf x ih
|
||
|
||
omit [Preorder α] in
|
||
theorem foldl_mono' (l : List α) (f : β → α → β)
|
||
(hf : ∀ a, Monotone (f · a)) : Monotone fun b => l.foldl f b := by
|
||
intro b₁ b₂ hb
|
||
induction l generalizing b₁ b₂ with
|
||
| nil => exact hb
|
||
| cons x xs ih => exact ih (hf x hb)
|
||
|
||
end Folds
|
||
|
||
def BoundedChains (α : Type*) [Preorder α] (n : ℕ) : Prop :=
|
||
∀ c : LTSeries α, c.length ≤ n
|
||
|
||
structure PointedLTSeries (α : Type*) (f t : α)(n : ℕ) [Preorder α] where
|
||
series : LTSeries α
|
||
head_series : series.head = f
|
||
last_series : series.last = t
|
||
length_series : series.length = n
|
||
|
||
theorem BoundedChains.no_longer {α : Type*} [Preorder α] {n : ℕ}
|
||
(h : BoundedChains α n) (c : LTSeries α) : c.length ≠ n + 1 :=
|
||
fun hc => absurd (h c) (by omega)
|
||
|
||
class FiniteHeightLattice (α : Type*) [Lattice α] extends Bot α, Top α where
|
||
height : ℕ
|
||
longest_chain : PointedLTSeries α ⊥ ⊤ height
|
||
chains_bounded : BoundedChains α height
|
||
|
||
namespace FixedHeight
|
||
|
||
variable {α : Type*} [Lattice α] {h : ℕ}
|
||
|
||
theorem bot_le [FiniteHeightLattice α] : ∀ (a : α), ⊥ ≤ a := by
|
||
intro a
|
||
by_cases heq : ⊥ ⊓ a = ⊥
|
||
· exact inf_eq_left.mp heq
|
||
· exfalso
|
||
have lc := FiniteHeightLattice.longest_chain (α := α)
|
||
have hlt : ⊥ ⊓ a < lc.series.head := by
|
||
rw [lc.head_series]
|
||
exact lt_of_le_of_ne inf_le_left heq
|
||
exact FiniteHeightLattice.chains_bounded.no_longer
|
||
(lc.series.cons (⊥ ⊓ a) hlt)
|
||
(by simp [RelSeries.cons_length, lc.length_series])
|
||
|
||
end FixedHeight
|
||
|
||
namespace FiniteHeightLattice
|
||
|
||
variable (α : Type*) [Lattice α] [FiniteHeightLattice α]
|
||
|
||
theorem bot_le (a : α) : (⊥ : α) ≤ a := FixedHeight.bot_le a
|
||
|
||
end FiniteHeightLattice
|
||
|
||
end Spa
|