2023-04-04 21:08:31 -07:00
|
|
|
|
module Lattice where
|
|
|
|
|
|
2023-04-06 23:08:49 -07:00
|
|
|
|
import Data.Nat.Properties as NatProps
|
|
|
|
|
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; sym)
|
2023-04-04 21:08:31 -07:00
|
|
|
|
open import Relation.Binary.Definitions
|
2023-04-06 23:08:49 -07:00
|
|
|
|
open import Data.Nat as Nat using (ℕ; _≤_)
|
|
|
|
|
open import Data.Product using (_×_; _,_)
|
2023-07-13 21:50:27 -07:00
|
|
|
|
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
|
|
|
|
open import Agda.Primitive using (lsuc; Level)
|
2023-04-04 21:08:31 -07:00
|
|
|
|
|
2023-04-06 23:08:49 -07:00
|
|
|
|
open import NatMap using (NatMap)
|
2023-04-04 21:08:31 -07:00
|
|
|
|
|
2023-07-15 12:18:50 -07:00
|
|
|
|
record IsSemilattice {a} (A : Set a) (_⊔_ : A → A → A) : Set a where
|
2023-04-06 23:08:49 -07:00
|
|
|
|
field
|
2023-07-13 21:50:27 -07:00
|
|
|
|
⊔-assoc : (x y z : A) → (x ⊔ y) ⊔ z ≡ x ⊔ (y ⊔ z)
|
|
|
|
|
⊔-comm : (x y : A) → x ⊔ y ≡ y ⊔ x
|
2023-04-04 21:08:31 -07:00
|
|
|
|
⊔-idemp : (x : A) → x ⊔ x ≡ x
|
|
|
|
|
|
2023-04-06 23:08:49 -07:00
|
|
|
|
record Semilattice {a} (A : Set a) : Set (lsuc a) where
|
2023-04-04 21:08:31 -07:00
|
|
|
|
field
|
2023-04-06 23:08:49 -07:00
|
|
|
|
_⊔_ : A → A → A
|
2023-04-04 21:08:31 -07:00
|
|
|
|
|
2023-07-15 12:18:50 -07:00
|
|
|
|
isSemilattice : IsSemilattice A _⊔_
|
2023-04-06 23:08:49 -07:00
|
|
|
|
|
|
|
|
|
open IsSemilattice isSemilattice public
|
|
|
|
|
|
2023-07-15 12:18:50 -07:00
|
|
|
|
record IsLattice {a} (A : Set a) (_⊔_ : A → A → A) (_⊓_ : A → A → A) : Set a where
|
2023-04-04 21:08:31 -07:00
|
|
|
|
field
|
2023-07-15 12:18:50 -07:00
|
|
|
|
joinSemilattice : IsSemilattice A _⊔_
|
|
|
|
|
meetSemilattice : IsSemilattice A _⊓_
|
2023-04-06 23:08:49 -07:00
|
|
|
|
|
2023-07-13 21:50:27 -07:00
|
|
|
|
absorb-⊔-⊓ : (x y : A) → x ⊔ (x ⊓ y) ≡ x
|
|
|
|
|
absorb-⊓-⊔ : (x y : A) → x ⊓ (x ⊔ y) ≡ x
|
2023-04-04 21:08:31 -07:00
|
|
|
|
|
2023-04-06 23:08:49 -07:00
|
|
|
|
open IsSemilattice joinSemilattice public
|
|
|
|
|
open IsSemilattice meetSemilattice public renaming
|
|
|
|
|
( ⊔-assoc to ⊓-assoc
|
|
|
|
|
; ⊔-comm to ⊓-comm
|
|
|
|
|
; ⊔-idemp to ⊓-idemp
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
record Lattice {a} (A : Set a) : Set (lsuc a) where
|
|
|
|
|
field
|
|
|
|
|
_⊔_ : A → A → A
|
|
|
|
|
_⊓_ : A → A → A
|
|
|
|
|
|
2023-07-15 12:18:50 -07:00
|
|
|
|
isLattice : IsLattice A _⊔_ _⊓_
|
2023-04-06 23:08:49 -07:00
|
|
|
|
|
|
|
|
|
open IsLattice isLattice public
|
|
|
|
|
|
2023-07-14 19:59:07 -07:00
|
|
|
|
module SemilatticeInstances where
|
|
|
|
|
module ForNat where
|
|
|
|
|
open Nat
|
|
|
|
|
open NatProps
|
|
|
|
|
open Eq
|
|
|
|
|
|
|
|
|
|
NatMaxSemilattice : Semilattice ℕ
|
|
|
|
|
NatMaxSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ _⊔_ = _⊔_
|
2023-07-14 19:59:07 -07:00
|
|
|
|
; isSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ ⊔-assoc = ⊔-assoc
|
2023-07-14 19:59:07 -07:00
|
|
|
|
; ⊔-comm = ⊔-comm
|
|
|
|
|
; ⊔-idemp = ⊔-idem
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
NatMinSemilattice : Semilattice ℕ
|
|
|
|
|
NatMinSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ _⊔_ = _⊓_
|
2023-07-14 19:59:07 -07:00
|
|
|
|
; isSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ ⊔-assoc = ⊓-assoc
|
2023-07-14 19:59:07 -07:00
|
|
|
|
; ⊔-comm = ⊓-comm
|
|
|
|
|
; ⊔-idemp = ⊓-idem
|
|
|
|
|
}
|
|
|
|
|
}
|
2023-07-14 19:42:29 -07:00
|
|
|
|
|
2023-07-14 21:20:16 -07:00
|
|
|
|
module ForProd {a} {A B : Set a} (sA : Semilattice A) (sB : Semilattice B) where
|
|
|
|
|
open Eq
|
|
|
|
|
open Data.Product
|
|
|
|
|
|
|
|
|
|
private
|
|
|
|
|
_⊔_ : A × B → A × B → A × B
|
|
|
|
|
(a₁ , b₁) ⊔ (a₂ , b₂) = (Semilattice._⊔_ sA a₁ a₂ , Semilattice._⊔_ sB b₁ b₂)
|
|
|
|
|
|
|
|
|
|
⊔-assoc : (p₁ p₂ p₃ : A × B) → (p₁ ⊔ p₂) ⊔ p₃ ≡ p₁ ⊔ (p₂ ⊔ p₃)
|
|
|
|
|
⊔-assoc (a₁ , b₁) (a₂ , b₂) (a₃ , b₃)
|
|
|
|
|
rewrite Semilattice.⊔-assoc sA a₁ a₂ a₃
|
|
|
|
|
rewrite Semilattice.⊔-assoc sB b₁ b₂ b₃ = refl
|
|
|
|
|
|
|
|
|
|
⊔-comm : (p₁ p₂ : A × B) → p₁ ⊔ p₂ ≡ p₂ ⊔ p₁
|
|
|
|
|
⊔-comm (a₁ , b₁) (a₂ , b₂)
|
|
|
|
|
rewrite Semilattice.⊔-comm sA a₁ a₂
|
|
|
|
|
rewrite Semilattice.⊔-comm sB b₁ b₂ = refl
|
|
|
|
|
|
|
|
|
|
⊔-idemp : (p : A × B) → p ⊔ p ≡ p
|
|
|
|
|
⊔-idemp (a , b)
|
|
|
|
|
rewrite Semilattice.⊔-idemp sA a
|
|
|
|
|
rewrite Semilattice.⊔-idemp sB b = refl
|
|
|
|
|
|
|
|
|
|
ProdSemilattice : Semilattice (A × B)
|
|
|
|
|
ProdSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ _⊔_ = _⊔_
|
2023-07-14 21:20:16 -07:00
|
|
|
|
; isSemilattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ ⊔-assoc = ⊔-assoc
|
2023-07-14 21:20:16 -07:00
|
|
|
|
; ⊔-comm = ⊔-comm
|
|
|
|
|
; ⊔-idemp = ⊔-idemp
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2023-07-14 21:49:47 -07:00
|
|
|
|
module LatticeInstances where
|
|
|
|
|
module ForNat where
|
|
|
|
|
open Nat
|
|
|
|
|
open NatProps
|
|
|
|
|
open Eq
|
|
|
|
|
open SemilatticeInstances.ForNat
|
|
|
|
|
open Data.Product
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
private
|
2023-07-15 12:18:50 -07:00
|
|
|
|
max-bound₁ : {x y z : ℕ} → x ⊔ y ≡ z → x ≤ z
|
|
|
|
|
max-bound₁ {x} {y} {z} x⊔y≡z rewrite sym x⊔y≡z rewrite ⊔-comm x y = m≤n⇒m≤o⊔n y (≤-refl)
|
|
|
|
|
|
|
|
|
|
min-bound₁ : {x y z : ℕ} → x ⊓ y ≡ z → z ≤ x
|
|
|
|
|
min-bound₁ {x} {y} {z} x⊓y≡z rewrite sym x⊓y≡z = m≤n⇒m⊓o≤n y (≤-refl)
|
|
|
|
|
|
2023-07-14 21:49:47 -07:00
|
|
|
|
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))
|
|
|
|
|
where
|
2023-07-15 12:18:50 -07:00
|
|
|
|
x⊓x⊔y≤x = min-bound₁ {x} {x ⊔ y} {x ⊓ (x ⊔ y)} refl
|
|
|
|
|
x⊓x≤x⊓x⊔y = ⊓-mono-≤ {x} {x} ≤-refl (max-bound₁ {x} {y} {x ⊔ y} refl)
|
2023-07-14 21:49:47 -07:00
|
|
|
|
|
|
|
|
|
-- >:(
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
where
|
2023-07-15 12:18:50 -07:00
|
|
|
|
x≤x⊔x⊓y = max-bound₁ {x} {x ⊓ y} {x ⊔ (x ⊓ y)} refl
|
|
|
|
|
x⊔x⊓y≤x⊔x = ⊔-mono-≤ {x} {x} ≤-refl (min-bound₁ {x} {y} {x ⊓ y} refl)
|
2023-07-14 21:49:47 -07:00
|
|
|
|
|
|
|
|
|
-- >:(
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
NatLattice : Lattice ℕ
|
|
|
|
|
NatLattice = record
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ _⊔_ = _⊔_
|
2023-07-14 21:49:47 -07:00
|
|
|
|
; _⊓_ = _⊓_
|
|
|
|
|
; isLattice = record
|
|
|
|
|
{ joinSemilattice = Semilattice.isSemilattice NatMaxSemilattice
|
|
|
|
|
; meetSemilattice = Semilattice.isSemilattice NatMinSemilattice
|
|
|
|
|
; absorb-⊔-⊓ = λ x y → maxmin-absorb {x} {y}
|
|
|
|
|
; absorb-⊓-⊔ = λ x y → minmax-absorb {x} {y}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
module ForProd {a} {A B : Set a} (lA : Lattice A) (lB : Lattice B) where
|
|
|
|
|
private
|
2023-07-15 12:18:50 -07:00
|
|
|
|
module ProdJoin = SemilatticeInstances.ForProd
|
|
|
|
|
record { _⊔_ = Lattice._⊔_ lA; isSemilattice = Lattice.joinSemilattice lA }
|
|
|
|
|
record { _⊔_ = Lattice._⊔_ lB; isSemilattice = Lattice.joinSemilattice lB }
|
|
|
|
|
module ProdMeet = SemilatticeInstances.ForProd
|
|
|
|
|
record { _⊔_ = Lattice._⊓_ lA; isSemilattice = Lattice.meetSemilattice lA }
|
|
|
|
|
record { _⊔_ = Lattice._⊓_ lB; isSemilattice = Lattice.meetSemilattice lB }
|
2023-07-14 21:49:47 -07:00
|
|
|
|
|
|
|
|
|
_⊔_ = 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
|
2023-07-15 12:18:50 -07:00
|
|
|
|
{ _⊔_ = _⊔_
|
2023-07-14 21:49:47 -07:00
|
|
|
|
; _⊓_ = _⊓_
|
|
|
|
|
; isLattice = record
|
|
|
|
|
{ joinSemilattice = Semilattice.isSemilattice ProdJoin.ProdSemilattice
|
|
|
|
|
; meetSemilattice = Semilattice.isSemilattice ProdMeet.ProdSemilattice
|
|
|
|
|
; absorb-⊔-⊓ = absorb-⊔-⊓
|
|
|
|
|
; absorb-⊓-⊔ = absorb-⊓-⊔
|
|
|
|
|
}
|
2023-07-13 23:22:29 -07:00
|
|
|
|
}
|