Files
agda-spa/lean/Spa/Lattice.lean
Danila Fedorin e2df847139 Adopt lemma as the default keyword
Convert every theorem to lemma (mathlib's default) except the headline results a
reader of each module seeks out: analyze_correct (Forward/Sign/Constant),
aFix_eq/aFix_le (Fixedpoint), trace (Language), and Stmt.cfg_sufficient
(Language/Properties). lemma and theorem are interchangeable keywords, so no
references change.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-06-25 14:08:10 -05:00

83 lines
2.7 KiB
Lean4
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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 β]
lemma 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)
lemma 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
lemma 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
lemma 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
class FiniteHeightLattice (α : Type*) [Lattice α] extends Bot α, Top α where
height :
longestChain : PointedLTSeries α height
chains_bounded : BoundedChains α height
namespace FiniteHeightLattice
variable (α : Type*) [Lattice α] [FiniteHeightLattice α]
lemma bot_le (a : α) : ( : α) a := by
by_cases heq : a =
· exact inf_eq_left.mp heq
· exfalso
have lc := FiniteHeightLattice.longestChain (α := α)
have hlt : a < lc.series.head := by
rw [lc.head_series]
exact lt_of_le_of_ne inf_le_left heq
have hbound := FiniteHeightLattice.chains_bounded (lc.series.cons ( a) hlt)
rw [RelSeries.cons_length, lc.length_series] at hbound
omega
end FiniteHeightLattice
end Spa