@@ -7,6 +7,12 @@ open import Cubical.Foundations.HLevels
77open import Cubical.Foundations.SIP
88
99open import Cubical.Reflection.RecordEquiv
10+ open import Cubical.Reflection.StrictEquiv
11+
12+ open import Cubical.Displayed.Base
13+ open import Cubical.Displayed.Auto
14+ open import Cubical.Displayed.Record
15+ open import Cubical.Displayed.Universe
1016
1117open import Cubical.Relation.Binary.Base
1218open import Cubical.Relation.Binary.Order.Poset renaming (
@@ -17,7 +23,7 @@ open BinaryRelation
1723
1824private
1925 variable
20- ℓ ℓ' : Level
26+ ℓ ℓ' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
2127
2228record IsPseudolattice {L : Type ℓ} (_≤_ : L → L → Type ℓ') : Type (ℓ-max ℓ ℓ') where
2329 constructor ispseudolattice
@@ -72,8 +78,78 @@ makeIsPseudolattice {_≤_ = _≤_} is-setL is-prop-valued is-refl is-trans is-a
7278 PS .IsPseudolattice.isPoset = isposet is-setL is-prop-valued is-refl is-trans is-antisym
7379 PS .IsPseudolattice.isPseudolattice = is-meet-semipseudolattice , is-join-semipseudolattice
7480
81+
82+ record IsPseudolatticeEquiv {A : Type ℓ₀} {B : Type ℓ₁}
83+ (M : PseudolatticeStr ℓ₀' A) (e : A ≃ B) (N : PseudolatticeStr ℓ₁' B)
84+ : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
85+ where
86+ constructor
87+ ispseudolatticeequiv
88+ -- Shorter qualified names
89+ private
90+ module M = PseudolatticeStr M
91+ module N = PseudolatticeStr N
92+
93+ field
94+ pres≤ : (x y : A) → x M.≤ y ≃ equivFun e x N.≤ equivFun e y
95+
96+
97+ PseudolatticeEquiv : ∀ {ℓ₀ ℓ₀' ℓ₁ ℓ₁'}
98+ → (M : Pseudolattice ℓ₀ ℓ₀') (N : Pseudolattice ℓ₁ ℓ₁')
99+ → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
100+ PseudolatticeEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsPseudolatticeEquiv (M .snd) e (N .snd)
101+
75102isPropIsPseudolattice : {L : Type ℓ} (_≤_ : L → L → Type ℓ') → isProp (IsPseudolattice _≤_)
76103isPropIsPseudolattice {L = L} _≤_ = isOfHLevelRetractFromIso 1
77104 IsPseudolatticeIsoΣ $ isPropΣ
78105 (isPropIsPoset _≤_) λ isPoset →
79106 is-prop-is-pseudolattice (poset L _≤_ isPoset)
107+
108+ 𝒮ᴰ-Pseudolattice : DUARel (𝒮-Univ ℓ) (PseudolatticeStr ℓ') (ℓ-max ℓ ℓ')
109+ 𝒮ᴰ-Pseudolattice =
110+ 𝒮ᴰ-Record (𝒮-Univ _) IsPseudolatticeEquiv
111+ (fields:
112+ data[ _≤_ ∣ autoDUARel _ _ ∣ pres≤ ]
113+ prop[ is-pseudolattice ∣ (λ _ _ → isPropIsPseudolattice _) ])
114+ where
115+ open PseudolatticeStr
116+ open IsPseudolattice
117+ open IsPseudolatticeEquiv
118+
119+ PseudolatticePath : (M N : Pseudolattice ℓ ℓ') → PseudolatticeEquiv M N ≃ (M ≡ N)
120+ PseudolatticePath = ∫ 𝒮ᴰ-Pseudolattice .UARel.ua
121+
122+ -- an easier way of establishing an equivalence of pseudolattices
123+ module _ {P : Pseudolattice ℓ₀ ℓ₀'} {S : Pseudolattice ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
124+ private
125+ module P = PseudolatticeStr (P .snd)
126+ module S = PseudolatticeStr (S .snd)
127+
128+ module _ (isMon : ∀ x y → x P.≤ y → equivFun e x S.≤ equivFun e y)
129+ (isMonInv : ∀ x y → x S.≤ y → invEq e x P.≤ invEq e y) where
130+ open IsPseudolatticeEquiv
131+ open IsPseudolattice
132+
133+ makeIsPseudolatticeEquiv : IsPseudolatticeEquiv (P .snd) e (S .snd)
134+ pres≤ makeIsPseudolatticeEquiv x y = propBiimpl→Equiv
135+ (P.is-pseudolattice .is-prop-valued _ _)
136+ (S.is-pseudolattice .is-prop-valued _ _)
137+ (isMon _ _) (isMonInv' _ _)
138+ where
139+ isMonInv' : ∀ x y → equivFun e x S.≤ equivFun e y → x P.≤ y
140+ isMonInv' x y ex≤ey = transport (λ i → retEq e x i P.≤ retEq e y i) (isMonInv _ _ ex≤ey)
141+
142+
143+ module PseudolatticeReasoning (P' : Pseudolattice ℓ ℓ') where
144+ private P = fst P'
145+ open PseudolatticeStr (snd P')
146+ open IsPseudolattice
147+
148+ _≤⟨_⟩_ : (x : P) {y z : P} → x ≤ y → y ≤ z → x ≤ z
149+ x ≤⟨ p ⟩ q = is-pseudolattice .is-trans x _ _ p q
150+
151+ _◾ : (x : P) → x ≤ x
152+ x ◾ = is-pseudolattice .is-refl x
153+
154+ infixr 0 _≤⟨_⟩_
155+ infix 1 _◾
0 commit comments