Simplifications

This commit is contained in:
Frederik Hanghøj Iversen 2018-04-11 14:10:01 +02:00
parent 1c963db7e6
commit 5c4b4db692

View file

@ -8,17 +8,10 @@ open import Cubical.PathPrelude hiding (inverse ; _≃_)
open import Cubical.PathPrelude using (isEquiv ; isContr ; fiber) public open import Cubical.PathPrelude using (isEquiv ; isContr ; fiber) public
open import Cubical.GradLemma open import Cubical.GradLemma
open import Cat.Prelude using (lemPropF ; setPi ; lemSig ; propSet ; Preorder ; equalityIsEquivalence ; _≃_) open import Cat.Prelude using (lemPropF ; setPi ; lemSig ; propSet ; Preorder ; equalityIsEquivalence ; _≃_ ; propSig)
import Cubical.Univalence as U import Cubical.Univalence as U
module _ {a b : Level} {A : Set a} {B : Set b} where
open Cubical.PathPrelude
deEta : A B A U.≃ B
deEta (a , b) = U.con a b
doEta : A U.≃ B A B
doEta (U.con eqv isEqv) = eqv , isEqv
module _ { : Level} {A B : Set } where module _ { : Level} {A B : Set } where
open Cubical.PathPrelude open Cubical.PathPrelude
ua : A B A B ua : A B A B
@ -40,19 +33,10 @@ module _ {a b : Level} where
obverse = f obverse = f
reverse = g reverse = g
inverse = reverse inverse = reverse
toPair : Σ _ _
toPair = verso-recto , recto-verso
Isomorphism : (f : A B) Set _ Isomorphism : (f : A B) Set _
Isomorphism f = Σ (B A) λ g AreInverses f g Isomorphism f = Σ (B A) λ g AreInverses f g
module _ {f : A B} {g : B A}
(inv : (g f) idFun A
× (f g) idFun B) where
open Σ inv renaming (fst to ve-re ; snd to re-ve)
toAreInverses : AreInverses f g
toAreInverses = ve-re , re-ve
_≅_ : Set a Set b Set _ _≅_ : Set a Set b Set _
A B = Σ (A B) Isomorphism A B = Σ (A B) Isomorphism
@ -127,7 +111,8 @@ module _ {a b : Level} (A : Set a) (B : Set b) where
fromIso (toIso x) ≡⟨ propIsEquiv _ (fromIso (toIso x)) x fromIso (toIso x) ≡⟨ propIsEquiv _ (fromIso (toIso x)) x
x x
-- `toIso` is abstract - so I probably can't close this proof. -- | The other inverse law does not hold in general, it does hold, however,
-- | if `A` and `B` are sets.
module _ (sA : isSet A) (sB : isSet B) where module _ (sA : isSet A) (sB : isSet B) where
module _ {f : A B} (iso : Isomorphism f) where module _ {f : A B} (iso : Isomorphism f) where
module _ (iso-x iso-y : Isomorphism f) where module _ (iso-x iso-y : Isomorphism f) where
@ -275,26 +260,20 @@ module _ {a b : Level} {A : Set a} {B : Set b} where
composeIso : {c : Level} {C : Set c} (A B) (B C) A C composeIso : {c : Level} {C : Set c} (A B) (B C) A C
composeIso {C = C} (f , iso-f) (g , iso-g) = g f , composeIsomorphism iso-f iso-g composeIso {C = C} (f , iso-f) (g , iso-g) = g f , composeIsomorphism iso-f iso-g
-- Gives the quasi inverse from an equivalence. symmetryIso : (A B) B A
module Equivalence (e : A B) where symmetryIso (inverse , obverse , verso-recto , recto-verso)
private = obverse
iso : Isomorphism (fst e) , inverse
iso = snd (toIsomorphism _ _ e)
open AreInverses {f = fst e} {fst iso} (snd iso) public
compose : {c : Level} {C : Set c} (B C) A C
compose (f , isEquiv) = f obverse , composeIsEquiv (snd e) isEquiv
symmetryIso : B A
symmetryIso
= inverse
, obverse
, recto-verso , recto-verso
, verso-recto , verso-recto
-- Gives the quasi inverse from an equivalence.
module Equivalence (e : A B) where
compose : {c : Level} {C : Set c} (B C) A C
compose e' = fromIsomorphism _ _ (composeIso (toIsomorphism _ _ e) (toIsomorphism _ _ e'))
symmetry : B A symmetry : B A
symmetry = fromIsomorphism _ _ symmetryIso symmetry = fromIsomorphism _ _ (symmetryIso (toIsomorphism _ _ e))
preorder≅ : ( : Level) Preorder _ _ _ preorder≅ : ( : Level) Preorder _ _ _
preorder≅ = record preorder≅ = record
@ -304,7 +283,6 @@ preorder≅ = record
; reflexive = λ p ; reflexive = λ p
coe p coe p
, coe (sym p) , coe (sym p)
-- I believe I stashed the proof of this somewhere.
, funExt (λ x inv-coe p) , funExt (λ x inv-coe p)
, funExt (λ x inv-coe' p) , funExt (λ x inv-coe' p)
; trans = composeIso ; trans = composeIso
@ -346,6 +324,11 @@ module _ { : Level} {A B : Set } where
univalence : (A B) (A B) univalence : (A B) (A B)
univalence = Equivalence.compose u' aux univalence = Equivalence.compose u' aux
where where
module _ {a b : Level} {A : Set a} {B : Set b} where
deEta : A B A U.≃ B
deEta (a , b) = U.con a b
doEta : A U.≃ B A B
doEta (U.con eqv isEqv) = eqv , isEqv
u : (A B) U.≃ (A U.≃ B) u : (A B) U.≃ (A U.≃ B)
u = U.univalence u = U.univalence
u' : (A B) (A U.≃ B) u' : (A B) (A U.≃ B)