Helpers to work with isomorphisms and equivalences

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-19 15:15:03 +01:00
parent f69ab0ee62
commit 2058154c65
2 changed files with 62 additions and 5 deletions

View file

@ -18,9 +18,13 @@ open import Cat.Wishlist
open import Cat.Equivalence as Eqv renaming (module NoEta to Eeq) using (AreInverses)
module Equivalence = Eeq.Equivalence
postulate
_⊙_ : {a b c : Level} {A : Set a} {B : Set b} {C : Set c} (A B) (B C) A C
sym≃ : {a b} {A : Set a} {B : Set b} A B B A
_⊙_ : {a b c : Level} {A : Set a} {B : Set b} {C : Set c} (A B) (B C) A C
eqA eqB = Equivalence.compose eqA eqB
sym≃ : {a b} {A : Set a} {B : Set b} A B B A
sym≃ = Equivalence.symmetry
infixl 10 _⊙_
module _ ( : Level) where

View file

@ -144,7 +144,48 @@ module _ {a b : Level} {A : Set a} {B : Set b} where
open AreInverses (snd iso) public
module NoEta {a b : Level} {A : Set a} {B : Set b} where
composeIso : {c : Level} {C : Set c} (B C) A C
composeIso {C = C} (g , g' , iso-g) = g obverse , inverse g' , inv
where
module iso-g = AreInverses iso-g
inv : AreInverses (g obverse) (inverse g')
AreInverses.verso-recto inv = begin
(inverse g') (g obverse) ≡⟨⟩
(inverse (g' g) obverse)
≡⟨ cong (λ φ φ obverse) (cong (λ φ inverse φ) iso-g.verso-recto)
(inverse idFun B obverse) ≡⟨⟩
(inverse obverse) ≡⟨ verso-recto
idFun A
AreInverses.recto-verso inv = begin
g obverse inverse g'
≡⟨ cong (λ φ φ g') (cong (λ φ g φ) recto-verso)
g idFun B g' ≡⟨⟩
g g' ≡⟨ iso-g.recto-verso
idFun C
compose : {c : Level} {C : Set c} (B C) A C
compose {C = C} e = A≃C.fromIsomorphism is
where
module B≃C = Equiv≃ B C
module A≃C = Equiv≃ A C
is : A C
is = composeIso (B≃C.toIsomorphism e)
symmetryIso : B A
symmetryIso
= inverse
, obverse
, record
{ verso-recto = recto-verso
; recto-verso = verso-recto
}
symmetry : B A
symmetry = B≃A.fromIsomorphism symmetryIso
where
module B≃A = Equiv≃ B A
module _ {a b : Level} {A : Set a} {B : Set b} where
open import Cubical.PathPrelude renaming (_≃_ to _≃η_)
open import Cubical.Univalence using (_≃_)
@ -154,8 +195,20 @@ module NoEta {a b : Level} {A : Set a} {B : Set b} where
deEta : A ≃η B A B
deEta (eqv , isEqv) = _≃_.con eqv isEqv
module NoEta {a b : Level} {A : Set a} {B : Set b} where
open import Cubical.PathPrelude renaming (_≃_ to _≃η_)
open import Cubical.Univalence using (_≃_)
module Equivalence (e : A B) where
open Equivalence (doEta e) hiding (toIsomorphism ; fromIsomorphism ; _~_) public
open Equivalence (doEta e) hiding
( toIsomorphism ; fromIsomorphism ; _~_
; compose ; symmetryIso ; symmetry ) public
compose : {c : Level} {C : Set c} (B C) A C
compose ee = deEta (Equivalence.compose (doEta e) (doEta ee))
symmetry : B A
symmetry = deEta (Equivalence.symmetry (doEta e))
fromIsomorphism : A B A B
fromIsomorphism (f , iso) = _≃_.con f (Equiv≃.fromIso _ _ iso)