DanilaFe/agda-spa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add proof of Lattice preservation

Browse Source 
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2023-09-29 21:19:48 -07:00
parent 7b24bae29a
commit bf74b35c14
1 changed files with 51 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
Homomorphism.agda
View File

@ -96,5 +96,54 @@ record LatticeHomomorphism (_⊔₁_ : A → A → A) (_⊔₂_ : B → B → B)
⊔-homomorphism : SemilatticeHomomorphism _⊔₁_ _⊔₂_
⊓-homomorphism : SemilatticeHomomorphism _⊓₁_ _⊓₂_
open SemilatticeHomomorphism ⊔-homomorphism using (f-preserves-≈)
open SemilatticeHomomorphism ⊓-homomorphism renaming (f-⊔-distr to f-⊓-distr)
open SemilatticeHomomorphism ⊔-homomorphism using (f-⊔-distr; f-preserves-≈) public
open SemilatticeHomomorphism ⊓-homomorphism using () renaming (f-⊔-distr to f-⊓-distr) public
module _ (_⊔₁_ : A → A → A) (_⊔₂_ : B → B → B)
(_⊓₁_ : A → A → A) (_⊓₂_ : B → B → B)
(lh : LatticeHomomorphism _⊔₁_ _⊔₂_ _⊓₁_ _⊓₂_)
(≈₂-⊔₂-cong : ∀ {a₁ a₂ a₃ a₄} → a₁ ≈₂ a₂ → a₃ ≈₂ a₄ → (a₁ ⊔₂ a₃) ≈₂ (a₂ ⊔₂ a₄))
(≈₂-⊓₂-cong : ∀ {a₁ a₂ a₃ a₄} → a₁ ≈₂ a₂ → a₃ ≈₂ a₄ → (a₁ ⊓₂ a₃) ≈₂ (a₂ ⊓₂ a₄))
(surF : Surjective _≈₁_ _≈₂_ f) where
open LatticeHomomorphism lh
transportLattice : IsLattice A _≈₁_ _⊔₁_ _⊓₁_ → IsLattice B _≈₂_ _⊔₂_ _⊓₂_
transportLattice lA = record
{ joinSemilattice = transportSemilattice _⊔₁_ _⊔₂_ (LatticeHomomorphism.⊔-homomorphism lh) ≈₂-⊔₂-cong surF (IsLattice.joinSemilattice lA)
; meetSemilattice = transportSemilattice _⊓₁_ _⊓₂_ (LatticeHomomorphism.⊓-homomorphism lh) ≈₂-⊓₂-cong surF (IsLattice.meetSemilattice lA)
; absorb-⊔-⊓ = λ b₁ b₂ →
let (a₁ , fa₁≈b₁) = surF b₁
(a₂ , fa₂≈b₂) = surF b₂
in
begin
b₁ ⊔₂ (b₁ ⊓₂ b₂)
∼⟨ ≈₂-⊔₂-cong (≈₂-sym fa₁≈b₁) (≈₂-⊓₂-cong (≈₂-sym fa₁≈b₁) (≈₂-sym fa₂≈b₂)) ⟩
f a₁ ⊔₂ (f a₁ ⊓₂ f a₂)
∼⟨ ≈₂-⊔₂-cong ≈₂-refl (≈₂-sym (f-⊓-distr a₁ a₂)) ⟩
f a₁ ⊔₂ f (a₁ ⊓₁ a₂)
∼⟨ ≈₂-sym (f-⊔-distr a₁ (a₁ ⊓₁ a₂)) ⟩
f (a₁ ⊔₁ (a₁ ⊓₁ a₂))
∼⟨ f-preserves-≈ (IsLattice.absorb-⊔-⊓ lA a₁ a₂) ⟩
f a₁
∼⟨ fa₁≈b₁ ⟩
b₁
∎
; absorb-⊓-⊔ = λ b₁ b₂ →
let (a₁ , fa₁≈b₁) = surF b₁
(a₂ , fa₂≈b₂) = surF b₂
in
begin
b₁ ⊓₂ (b₁ ⊔₂ b₂)
∼⟨ ≈₂-⊓₂-cong (≈₂-sym fa₁≈b₁) (≈₂-⊔₂-cong (≈₂-sym fa₁≈b₁) (≈₂-sym fa₂≈b₂)) ⟩
f a₁ ⊓₂ (f a₁ ⊔₂ f a₂)
∼⟨ ≈₂-⊓₂-cong ≈₂-refl (≈₂-sym (f-⊔-distr a₁ a₂)) ⟩
f a₁ ⊓₂ f (a₁ ⊔₁ a₂)
∼⟨ ≈₂-sym (f-⊓-distr a₁ (a₁ ⊔₁ a₂)) ⟩
f (a₁ ⊓₁ (a₁ ⊔₁ a₂))
∼⟨ f-preserves-≈ (IsLattice.absorb-⊓-⊔ lA a₁ a₂) ⟩
f a₁
∼⟨ fa₁≈b₁ ⟩
b₁
∎
}