Add a lattice instance for products
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
parent
3b29ee0f74
commit
cdca2528e9
129
Lattice.agda
129
Lattice.agda
|
|
@ -256,53 +256,98 @@ module SemilatticeInstances where
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
private module NatInstances where
|
module LatticeInstances where
|
||||||
open Nat
|
module ForNat where
|
||||||
open NatProps
|
open Nat
|
||||||
open Eq
|
open NatProps
|
||||||
open SemilatticeInstances.ForNat
|
open Eq
|
||||||
open Data.Product
|
open SemilatticeInstances.ForNat
|
||||||
|
open Data.Product
|
||||||
|
|
||||||
|
|
||||||
private
|
private
|
||||||
minmax-absorb : {x y : ℕ} → x ⊓ (x ⊔ y) ≡ x
|
minmax-absorb : {x y : ℕ} → x ⊓ (x ⊔ y) ≡ x
|
||||||
minmax-absorb {x} {y} = ≤-antisym x⊓x⊔y≤x (helper x⊓x≤x⊓x⊔y (⊓-idem x))
|
minmax-absorb {x} {y} = ≤-antisym x⊓x⊔y≤x (helper x⊓x≤x⊓x⊔y (⊓-idem x))
|
||||||
where
|
where
|
||||||
x⊓x⊔y≤x = proj₁ (Semilattice.⊔-bound NatMinSemilattice x (x ⊔ y) (x ⊓ (x ⊔ y)) refl)
|
x⊓x⊔y≤x = proj₁ (Semilattice.⊔-bound NatMinSemilattice x (x ⊔ y) (x ⊓ (x ⊔ y)) refl)
|
||||||
x⊓x≤x⊓x⊔y = ⊓-mono-≤ {x} {x} ≤-refl (proj₁ (Semilattice.⊔-bound NatMaxSemilattice x y (x ⊔ y) refl))
|
x⊓x≤x⊓x⊔y = ⊓-mono-≤ {x} {x} ≤-refl (proj₁ (Semilattice.⊔-bound NatMaxSemilattice x y (x ⊔ y) refl))
|
||||||
|
|
||||||
-- >:(
|
-- >:(
|
||||||
helper : x ⊓ x ≤ x ⊓ (x ⊔ y) → x ⊓ x ≡ x → x ≤ x ⊓ (x ⊔ y)
|
helper : x ⊓ x ≤ x ⊓ (x ⊔ y) → x ⊓ x ≡ x → x ≤ x ⊓ (x ⊔ y)
|
||||||
helper x⊓x≤x⊓x⊔y x⊓x≡x rewrite x⊓x≡x = x⊓x≤x⊓x⊔y
|
helper x⊓x≤x⊓x⊔y x⊓x≡x rewrite x⊓x≡x = x⊓x≤x⊓x⊔y
|
||||||
|
|
||||||
maxmin-absorb : {x y : ℕ} → x ⊔ (x ⊓ y) ≡ x
|
maxmin-absorb : {x y : ℕ} → x ⊔ (x ⊓ y) ≡ x
|
||||||
maxmin-absorb {x} {y} = ≤-antisym (helper x⊔x⊓y≤x⊔x (⊔-idem x)) x≤x⊔x⊓y
|
maxmin-absorb {x} {y} = ≤-antisym (helper x⊔x⊓y≤x⊔x (⊔-idem x)) x≤x⊔x⊓y
|
||||||
where
|
where
|
||||||
x≤x⊔x⊓y = proj₁ (Semilattice.⊔-bound NatMaxSemilattice x (x ⊓ y) (x ⊔ (x ⊓ y)) refl)
|
x≤x⊔x⊓y = proj₁ (Semilattice.⊔-bound NatMaxSemilattice x (x ⊓ y) (x ⊔ (x ⊓ y)) refl)
|
||||||
x⊔x⊓y≤x⊔x = ⊔-mono-≤ {x} {x} ≤-refl (proj₁ (Semilattice.⊔-bound NatMinSemilattice x y (x ⊓ y) refl))
|
x⊔x⊓y≤x⊔x = ⊔-mono-≤ {x} {x} ≤-refl (proj₁ (Semilattice.⊔-bound NatMinSemilattice x y (x ⊓ y) refl))
|
||||||
|
|
||||||
-- >:(
|
-- >:(
|
||||||
helper : x ⊔ (x ⊓ y) ≤ x ⊔ x → x ⊔ x ≡ x → x ⊔ (x ⊓ y) ≤ x
|
helper : x ⊔ (x ⊓ y) ≤ x ⊔ x → x ⊔ x ≡ x → x ⊔ (x ⊓ y) ≤ x
|
||||||
helper x⊔x⊓y≤x⊔x x⊔x≡x rewrite x⊔x≡x = x⊔x⊓y≤x⊔x
|
helper x⊔x⊓y≤x⊔x x⊔x≡x rewrite x⊔x≡x = x⊔x⊓y≤x⊔x
|
||||||
|
|
||||||
NatLattice : Lattice ℕ
|
NatLattice : Lattice ℕ
|
||||||
NatLattice = record
|
NatLattice = record
|
||||||
{ _≼_ = _≤_
|
{ _≼_ = _≤_
|
||||||
; _⊔_ = _⊔_
|
; _⊔_ = _⊔_
|
||||||
; _⊓_ = _⊓_
|
; _⊓_ = _⊓_
|
||||||
; isLattice = record
|
; isLattice = record
|
||||||
{ joinSemilattice = Semilattice.isSemilattice NatMaxSemilattice
|
{ joinSemilattice = Semilattice.isSemilattice NatMaxSemilattice
|
||||||
; meetSemilattice = Semilattice.isSemilattice NatMinSemilattice
|
; meetSemilattice = Semilattice.isSemilattice NatMinSemilattice
|
||||||
; absorb-⊔-⊓ = λ x y → maxmin-absorb {x} {y}
|
; absorb-⊔-⊓ = λ x y → maxmin-absorb {x} {y}
|
||||||
; absorb-⊓-⊔ = λ x y → minmax-absorb {x} {y}
|
; absorb-⊓-⊔ = λ x y → minmax-absorb {x} {y}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
-- ProdSemilattice : {a : Level} → {A B : Set a} → {{ Semilattice A }} → {{ Semilattice B }} → Semilattice (A × B)
|
module ForProd {a} {A B : Set a} (lA : Lattice A) (lB : Lattice B) where
|
||||||
-- ProdSemilattice {a} {A} {B} {{slA}} {{slB}} = record
|
private
|
||||||
-- { _≼_ = λ (a₁ , b₁) (a₂ , b₂) → Semilattice._≼_ slA a₁ a₂ × Semilattice._≼_ slB b₁ b₂
|
_≼₁_ = Lattice._≼_ lA
|
||||||
-- ; _⊔_ = λ (a₁ , b₁) (a₂ , b₂) → (Semilattice._⊔_ slA a₁ a₂ , Semilattice._⊔_ slB b₁ b₂)
|
_≼₂_ = Lattice._≼_ lB
|
||||||
-- ; isSemilattice = record
|
|
||||||
-- {
|
_⊔₁_ = Lattice._⊔_ lA
|
||||||
-- }
|
_⊔₂_ = Lattice._⊔_ lB
|
||||||
-- }
|
|
||||||
|
_⊓₁_ = Lattice._⊓_ lA
|
||||||
|
_⊓₂_ = Lattice._⊓_ lB
|
||||||
|
|
||||||
|
joinA = record { _≼_ = _≼₁_; _⊔_ = _⊔₁_; isSemilattice = Lattice.joinSemilattice lA }
|
||||||
|
joinB = record { _≼_ = _≼₂_; _⊔_ = _⊔₂_; isSemilattice = Lattice.joinSemilattice lB }
|
||||||
|
|
||||||
|
|
||||||
|
meetA = record { _≼_ = λ a b → b ≼₁ a; _⊔_ = _⊓₁_; isSemilattice = Lattice.meetSemilattice lA }
|
||||||
|
meetB = record { _≼_ = λ a b → b ≼₂ a; _⊔_ = _⊓₂_; isSemilattice = Lattice.meetSemilattice lB }
|
||||||
|
|
||||||
|
module ProdJoin = SemilatticeInstances.ForProd joinA joinB
|
||||||
|
module ProdMeet = SemilatticeInstances.ForProd meetA meetB
|
||||||
|
|
||||||
|
|
||||||
|
_≼_ = Semilattice._≼_ ProdJoin.ProdSemilattice
|
||||||
|
_⊔_ = Semilattice._⊔_ ProdJoin.ProdSemilattice
|
||||||
|
_⊓_ = Semilattice._⊔_ ProdMeet.ProdSemilattice
|
||||||
|
|
||||||
|
open Eq
|
||||||
|
open Data.Product
|
||||||
|
|
||||||
|
private
|
||||||
|
absorb-⊔-⊓ : (p₁ p₂ : A × B) → p₁ ⊔ (p₁ ⊓ p₂) ≡ p₁
|
||||||
|
absorb-⊔-⊓ (a₁ , b₁) (a₂ , b₂)
|
||||||
|
rewrite Lattice.absorb-⊔-⊓ lA a₁ a₂
|
||||||
|
rewrite Lattice.absorb-⊔-⊓ lB b₁ b₂ = refl
|
||||||
|
|
||||||
|
absorb-⊓-⊔ : (p₁ p₂ : A × B) → p₁ ⊓ (p₁ ⊔ p₂) ≡ p₁
|
||||||
|
absorb-⊓-⊔ (a₁ , b₁) (a₂ , b₂)
|
||||||
|
rewrite Lattice.absorb-⊓-⊔ lA a₁ a₂
|
||||||
|
rewrite Lattice.absorb-⊓-⊔ lB b₁ b₂ = refl
|
||||||
|
|
||||||
|
ProdLattice : Lattice (A × B)
|
||||||
|
ProdLattice = record
|
||||||
|
{ _≼_ = _≼_
|
||||||
|
; _⊔_ = _⊔_
|
||||||
|
; _⊓_ = _⊓_
|
||||||
|
; isLattice = record
|
||||||
|
{ joinSemilattice = Semilattice.isSemilattice ProdJoin.ProdSemilattice
|
||||||
|
; meetSemilattice = Semilattice.isSemilattice ProdMeet.ProdSemilattice
|
||||||
|
; absorb-⊔-⊓ = absorb-⊔-⊓
|
||||||
|
; absorb-⊓-⊔ = absorb-⊓-⊔
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user