Danila Fedorin
5ac881559d
This helps automatically derive lattice laws for it Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com> Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
66 lines
2.1 KiB
Lean4
66 lines
2.1 KiB
Lean4
import Spa.Lattice.IterProd
|
||
import Spa.Isomorphism
|
||
|
||
namespace Spa
|
||
|
||
namespace Tuple
|
||
|
||
universe u
|
||
|
||
variable {B : Type u}
|
||
|
||
private def iterOfFun : {n : ℕ} → (Fin n → B) → IterProd B PUnit n
|
||
| 0, _ => PUnit.unit
|
||
| _ + 1, f => (f 0, iterOfFun (Fin.tail f))
|
||
|
||
private def funOfIter : {n : ℕ} → IterProd B PUnit n → (Fin n → B)
|
||
| 0, _ => Fin.elim0
|
||
| _ + 1, ip => Fin.cons ip.1 (funOfIter ip.2)
|
||
|
||
private theorem funOfIter_iterOfFun : ∀ {n : ℕ} (f : Fin n → B),
|
||
funOfIter (iterOfFun f) = f
|
||
| 0, _ => funext fun i => i.elim0
|
||
| _ + 1, f => by
|
||
show Fin.cons (f 0) (funOfIter (iterOfFun (Fin.tail f))) = f
|
||
rw [funOfIter_iterOfFun (Fin.tail f), Fin.cons_self_tail]
|
||
|
||
private theorem iterOfFun_funOfIter : ∀ {n : ℕ} (ip : IterProd B PUnit n),
|
||
iterOfFun (funOfIter ip) = ip
|
||
| 0, PUnit.unit => rfl
|
||
| _ + 1, ip => by
|
||
show (funOfIter ip 0, iterOfFun (Fin.tail (funOfIter ip))) = ip
|
||
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]
|
||
|
||
private theorem funOfIter_mono {n : ℕ} :
|
||
Monotone (funOfIter : IterProd B PUnit n → (Fin n → B)) := by
|
||
induction n with
|
||
| zero => intro _ _ _ i; exact i.elim0
|
||
| succ n ih =>
|
||
intro ip₁ ip₂ h i
|
||
obtain ⟨h1, h2⟩ := Prod.le_def.mp h
|
||
rw [show funOfIter ip₁ = Fin.cons ip₁.1 (funOfIter ip₁.2) from rfl,
|
||
show funOfIter ip₂ = Fin.cons ip₂.1 (funOfIter ip₂.2) from rfl]
|
||
induction i using Fin.cases with
|
||
| zero => rw [Fin.cons_zero, Fin.cons_zero]; exact h1
|
||
| succ j => rw [Fin.cons_succ, Fin.cons_succ]; exact ih h2 j
|
||
|
||
private theorem iterOfFun_mono {n : ℕ} :
|
||
Monotone (iterOfFun : (Fin n → B) → IterProd B PUnit n) := by
|
||
induction n with
|
||
| zero => intro f g _; exact le_of_eq rfl
|
||
| succ n ih =>
|
||
intro f g h
|
||
exact Prod.le_def.mpr ⟨h 0, ih fun i => h i.succ⟩
|
||
|
||
instance instFiniteHeight {n : ℕ} [FiniteHeightLattice B] :
|
||
FiniteHeightLattice (Fin n → B) :=
|
||
FiniteHeightLattice.transport funOfIter iterOfFun
|
||
funOfIter_mono iterOfFun_mono iterOfFun_funOfIter funOfIter_iterOfFun
|
||
|
||
end Tuple
|
||
|
||
end Spa
|