Factor univalence out to a seperate module

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-20 18:11:14 +01:00
parent a4f8a37e36
commit 0c861c4bde

View file

@ -65,20 +65,10 @@ record RawCategory (a b : Level) : Set (lsuc (a ⊔ b)) where
Monomorphism : {X : Object} (f : Arrow A B) Set b Monomorphism : {X : Object} (f : Arrow A B) Set b
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) f g₀ f g₁ g₀ g₁ Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) f g₀ f g₁ g₀ g₁
-- Thierry: All projections must be `isProp`'s -- Univalence is indexed by a raw category as well as an identity proof.
module Univalence {a b : Level} ( : RawCategory a b) where
-- According to definitions 9.1.1 and 9.1.6 in the HoTT book the
-- arrows of a category form a set (arrow-is-set), and there is an
-- equivalence between the equality of objects and isomorphisms
-- (univalent).
record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc (a b)) where
open RawCategory open RawCategory
module Raw = RawCategory module _ (ident : IsIdentity 𝟙) where
field
assoc : IsAssociative
ident : IsIdentity 𝟙
arrowIsSet : {A B : Object} isSet (Arrow A B)
idIso : (A : Object) A A idIso : (A : Object) A A
idIso A = 𝟙 , (𝟙 , ident) idIso A = 𝟙 , (𝟙 , ident)
@ -90,8 +80,21 @@ record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc
-- equivalent formulations in the book. -- equivalent formulations in the book.
Univalent : Set (a b) Univalent : Set (a b)
Univalent = {A B : Object} isEquiv (A B) (A B) (id-to-iso A B) Univalent = {A B : Object} isEquiv (A B) (A B) (id-to-iso A B)
-- Thierry: All projections must be `isProp`'s
-- According to definitions 9.1.1 and 9.1.6 in the HoTT book the
-- arrows of a category form a set (arrow-is-set), and there is an
-- equivalence between the equality of objects and isomorphisms
-- (univalent).
record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc (a b)) where
open RawCategory
open Univalence public
field field
univalent : Univalent assoc : IsAssociative
ident : IsIdentity 𝟙
arrowIsSet : {A B : Object} isSet (Arrow A B)
univalent : Univalent ident
-- `IsCategory` is a mere proposition. -- `IsCategory` is a mere proposition.
module _ {a b : Level} {C : RawCategory a b} where module _ {a b : Level} {C : RawCategory a b} where
@ -136,7 +139,7 @@ module _ {a b : Level} {C : RawCategory a b} where
𝟙 g' ≡⟨ snd ident 𝟙 g' ≡⟨ snd ident
g' g'
propUnivalent : isProp Univalent propUnivalent : isProp (Univalent ident)
propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i
private private
@ -144,27 +147,21 @@ module _ {a b : Level} {C : RawCategory a b} where
module IC = IsCategory module IC = IsCategory
module X = IsCategory x module X = IsCategory x
module Y = IsCategory y module Y = IsCategory y
open Univalence C
-- In a few places I use the result of propositionality of the various -- In a few places I use the result of propositionality of the various
-- projections of `IsCategory` - I've arbitrarily chosed to use this -- projections of `IsCategory` - I've arbitrarily chosed to use this
-- result from `x : IsCategory C`. I don't know which (if any) possibly -- result from `x : IsCategory C`. I don't know which (if any) possibly
-- adverse effects this may have. -- adverse effects this may have.
ident : (λ _ IsIdentity 𝟙) [ X.ident Y.ident ] ident : (λ _ IsIdentity 𝟙) [ X.ident Y.ident ]
ident = propIsIdentity x X.ident Y.ident ident = propIsIdentity x X.ident Y.ident
-- A version of univalence indexed by the identity proof.
-- Note of course that since it's defined where `RawCategory ` has been opened
-- this is specialized to that category.
Univ : IsIdentity 𝟙 Set _
Univ idnt = {A B : Y.Raw.Object}
isEquiv (A B) (A B)
(λ eq transp (λ j A eq j) (𝟙 , 𝟙 , idnt))
done : x y done : x y
U : {a : IsIdentity 𝟙} (λ _ IsIdentity 𝟙) [ X.ident a ] (b : Univ a) Set _ U : {a : IsIdentity 𝟙} (λ _ IsIdentity 𝟙) [ X.ident a ] (b : Univalent a) Set _
U eqwal bbb = (λ i Univ (eqwal i)) [ X.univalent bbb ] U eqwal bbb = (λ i Univalent (eqwal i)) [ X.univalent bbb ]
P : (y : IsIdentity 𝟙) P : (y : IsIdentity 𝟙)
(λ _ IsIdentity 𝟙) [ X.ident y ] Set _ (λ _ IsIdentity 𝟙) [ X.ident y ] Set _
P y eq = (b' : Univ y) U eq b' P y eq = (b' : Univalent y) U eq b'
helper : (b' : Univ X.ident) helper : (b' : Univalent X.ident)
(λ _ Univ X.ident) [ X.univalent b' ] (λ _ Univalent X.ident) [ X.univalent b' ]
helper univ = propUnivalent x X.univalent univ helper univ = propUnivalent x X.univalent univ
foo = pathJ P helper Y.ident ident foo = pathJ P helper Y.ident ident
eqUni : U ident Y.univalent eqUni : U ident Y.univalent