Make 'isLattice' for simple types be an instance

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
2025-01-04 17:27:38 -08:00
parent 4da9b6d3cd
commit 8abf6f8670
2 changed files with 92 additions and 92 deletions

View File

@@ -18,31 +18,32 @@ private
≡-⊓-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₄)
≡-⊓-cong a₁≡a₂ a₃≡a₄ rewrite a₁≡a₂ rewrite a₃≡a₄ = refl ≡-⊓-cong a₁≡a₂ a₃≡a₄ rewrite a₁≡a₂ rewrite a₃≡a₄ = refl
isMaxSemilattice : IsSemilattice ℕ _≡_ _⊔_ instance
isMaxSemilattice = record isMaxSemilattice : IsSemilattice ℕ _≡_ _⊔_
{ ≈-equiv = record isMaxSemilattice = record
{ ≈-refl = refl { ≈-equiv = record
; ≈-sym = sym { ≈-refl = refl
; ≈-trans = trans ; ≈-sym = sym
; ≈-trans = trans
}
; ≈-⊔-cong = ≡-⊔-cong
; ⊔-assoc = ⊔-assoc
; ⊔-comm = ⊔-comm
; ⊔-idemp = ⊔-idem
} }
; ≈-⊔-cong = ≡-⊔-cong
; ⊔-assoc = ⊔-assoc
; ⊔-comm = ⊔-comm
; ⊔-idemp = ⊔-idem
}
isMinSemilattice : IsSemilattice ℕ _≡_ _⊓_ isMinSemilattice : IsSemilattice ℕ _≡_ _⊓_
isMinSemilattice = record isMinSemilattice = record
{ ≈-equiv = record { ≈-equiv = record
{ ≈-refl = refl { ≈-refl = refl
; ≈-sym = sym ; ≈-sym = sym
; ≈-trans = trans ; ≈-trans = trans
}
; ≈-⊔-cong = ≡-⊓-cong
; ⊔-assoc = ⊓-assoc
; ⊔-comm = ⊓-comm
; ⊔-idemp = ⊓-idem
} }
; ≈-⊔-cong = ≡-⊓-cong
; ⊔-assoc = ⊓-assoc
; ⊔-comm = ⊓-comm
; ⊔-idemp = ⊓-idem
}
private private
max-bound₁ : {x y z : ℕ} → x ⊔ y ≡ z → x ≤ z max-bound₁ : {x y z : ℕ} → x ⊔ y ≡ z → x ≤ z
@@ -74,18 +75,19 @@ private
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
isLattice : IsLattice ℕ _≡_ _⊔_ _⊓_ instance
isLattice = record isLattice : IsLattice ℕ _≡_ _⊔_ _⊓_
{ joinSemilattice = isMaxSemilattice isLattice = record
; meetSemilattice = isMinSemilattice { joinSemilattice = isMaxSemilattice
; absorb-⊔-⊓ = λ x y → maxmin-absorb {x} {y} ; meetSemilattice = isMinSemilattice
; absorb-⊓-⊔ = λ x y → minmax-absorb {x} {y} ; absorb-⊔-⊓ = λ x y → maxmin-absorb {x} {y}
} ; absorb-⊓-⊔ = λ x y → minmax-absorb {x} {y}
}
lattice : Lattice ℕ lattice : Lattice ℕ
lattice = record lattice = record
{ _≈_ = _≡_ { _≈_ = _≡_
; _⊔_ = _⊔_ ; _⊔_ = _⊔_
; _⊓_ = _⊓_ ; _⊓_ = _⊓_
; isLattice = isLattice ; isLattice = isLattice
} }

View File

@@ -45,14 +45,15 @@ tt ⊓ tt = tt
⊔-idemp : (x : ⊤) → (x ⊔ x) ≈ x ⊔-idemp : (x : ⊤) → (x ⊔ x) ≈ x
⊔-idemp tt = Eq.refl ⊔-idemp tt = Eq.refl
isJoinSemilattice : IsSemilattice ⊤ _≈_ _⊔_ instance
isJoinSemilattice = record isJoinSemilattice : IsSemilattice ⊤ _≈_ _⊔_
{ ≈-equiv = ≈-equiv isJoinSemilattice = record
; ≈-⊔-cong = ≈-⊔-cong { ≈-equiv = ≈-equiv
; ⊔-assoc = ⊔-assoc ; ≈-⊔-cong = ≈-⊔-cong
; ⊔-comm = ⊔-comm ; ⊔-assoc = ⊔-assoc
; ⊔-idemp = ⊔-idemp ; ⊔-comm = ⊔-comm
} ; ⊔-idemp = ⊔-idemp
}
≈-⊓-cong : ∀ {ab₁ ab₂ ab₃ ab₄} → ab₁ ≈ ab₂ → ab₃ ≈ ab₄ → (ab₁ ⊓ ab₃) ≈ (ab₂ ⊓ ab₄) ≈-⊓-cong : ∀ {ab₁ ab₂ ab₃ ab₄} → ab₁ ≈ ab₂ → ab₃ ≈ ab₄ → (ab₁ ⊓ ab₃) ≈ (ab₂ ⊓ ab₄)
≈-⊓-cong {tt} {tt} {tt} {tt} _ _ = Eq.refl ≈-⊓-cong {tt} {tt} {tt} {tt} _ _ = Eq.refl
@@ -66,36 +67,32 @@ isJoinSemilattice = record
⊓-idemp : (x : ⊤) → (x ⊓ x) ≈ x ⊓-idemp : (x : ⊤) → (x ⊓ x) ≈ x
⊓-idemp tt = Eq.refl ⊓-idemp tt = Eq.refl
isMeetSemilattice : IsSemilattice ⊤ _≈_ _⊓_ instance
isMeetSemilattice = record isMeetSemilattice : IsSemilattice ⊤ _≈_ _⊓_
{ ≈-equiv = ≈-equiv isMeetSemilattice = record
; ≈-⊔-cong = ≈-⊓-cong { ≈-equiv = ≈-equiv
; ⊔-assoc = ⊓-assoc ; ≈-⊔-cong = ≈-⊓-cong
; ⊔-comm = ⊓-comm ; ⊔-assoc = ⊓-assoc
; ⊔-idemp = ⊓-idemp ; ⊔-comm = ⊓-comm
} ; ⊔-idemp = ⊓-idemp
}
absorb-⊔-⊓ : (x y : ⊤) → (x ⊔ (x ⊓ y)) ≈ x instance
absorb-⊔-⊓ tt tt = Eq.refl isLattice : IsLattice ⊤ _≈_ _⊔_ _⊓_
isLattice = record
{ joinSemilattice = isJoinSemilattice
; meetSemilattice = isMeetSemilattice
; absorb-⊔-⊓ = λ { tt tt → Eq.refl }
; absorb-⊓-⊔ = λ { tt tt → Eq.refl }
}
absorb-⊓-⊔ : (x y : ⊤) → (x ⊓ (x ⊔ y)) ≈ x lattice : Lattice ⊤
absorb-⊓-⊔ tt tt = Eq.refl lattice = record
{ _≈_ = _≈_
isLattice : IsLattice ⊤ _≈_ _⊔_ _⊓_ ; _⊔_ = _⊔_
isLattice = record ; _⊓_ = _⊓_
{ joinSemilattice = isJoinSemilattice ; isLattice = isLattice
; meetSemilattice = isMeetSemilattice }
; absorb-⊔-⊓ = absorb-⊔-⊓
; absorb-⊓-⊔ = absorb-⊓-⊔
}
lattice : Lattice ⊤
lattice = record
{ _≈_ = _≈_
; _⊔_ = _⊔_
; _⊓_ = _⊓_
; isLattice = isLattice
}
open Chain _≈_ ≈-equiv (IsLattice._≺_ isLattice) (IsLattice.≺-cong isLattice) open Chain _≈_ ≈-equiv (IsLattice._≺_ isLattice) (IsLattice.≺-cong isLattice)
@@ -107,25 +104,26 @@ private
isLongest {tt} {tt} (step (tt⊔tt≈tt , tt̷≈tt) _ _) = ⊥-elim (tt̷≈tt refl) isLongest {tt} {tt} (step (tt⊔tt≈tt , tt̷≈tt) _ _) = ⊥-elim (tt̷≈tt refl)
isLongest (done _) = z≤n isLongest (done _) = z≤n
fixedHeight : IsLattice.FixedHeight isLattice 0 instance
fixedHeight = record fixedHeight : IsLattice.FixedHeight isLattice 0
{ ⊥ = tt fixedHeight = record
; ⊤ = tt { ⊥ = tt
; longestChain = longestChain ; ⊤ = tt
; bounded = isLongest ; longestChain = longestChain
} ; bounded = isLongest
}
isFiniteHeightLattice : IsFiniteHeightLattice ⊤ 0 _≈_ _⊔_ _⊓_ isFiniteHeightLattice : IsFiniteHeightLattice ⊤ 0 _≈_ _⊔_ _⊓_
isFiniteHeightLattice = record isFiniteHeightLattice = record
{ isLattice = isLattice { isLattice = isLattice
; fixedHeight = fixedHeight ; fixedHeight = fixedHeight
} }
finiteHeightLattice : FiniteHeightLattice ⊤ finiteHeightLattice : FiniteHeightLattice ⊤
finiteHeightLattice = record finiteHeightLattice = record
{ height = 0 { height = 0
; _≈_ = _≈_ ; _≈_ = _≈_
; _⊔_ = _⊔_ ; _⊔_ = _⊔_
; _⊓_ = _⊓_ ; _⊓_ = _⊓_
; isFiniteHeightLattice = isFiniteHeightLattice ; isFiniteHeightLattice = isFiniteHeightLattice
} }