changed IsCategory to follow the HoTT book definition.

This commit is contained in:
Andrea Vezzosi 2018-02-01 14:20:20 +00:00
parent f13b98b009
commit 8d5e992e48

View file

@ -22,6 +22,11 @@ open import Cubical
syntax ∃!-syntax (λ x B) = ∃![ x ] B syntax ∃!-syntax (λ x B) = ∃![ x ] B
-- 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 { ' : Level} record IsCategory { ' : Level}
(Object : Set ) (Object : Set )
(Arrow : Object Object Set ') (Arrow : Object Object Set ')
@ -33,11 +38,43 @@ record IsCategory { ' : Level}
h (g f) (h g) f h (g f) (h g) f
ident : {A B : Object} {f : Arrow A B} ident : {A B : Object} {f : Arrow A B}
f 𝟙 f × 𝟙 f f f 𝟙 f × 𝟙 f f
arrow-is-set : {A B : Object} isSet (Arrow A B)
Isomorphism : {A B} (f : Arrow A B) Set '
Isomorphism {A} {B} f = Σ[ g Arrow B A ] g f 𝟙 × f g 𝟙
_≅_ : (A B : Object) Set '
_≅_ A B = Σ[ f Arrow A B ] (Isomorphism f)
idIso : (A : Object) A A
idIso A = 𝟙 , (𝟙 , ident)
id-to-iso : (A B : Object) A B A B
id-to-iso A B eq = transp (\ i A eq i) (idIso A)
-- TODO: might want to implement isEquiv differently, there are 3
-- equivalent formulations in the book.
field
univalent : {A B : Object} isEquiv (A B) (A B) (id-to-iso A B)
module _ {} {'} {Object : Set }
{Arrow : Object Object Set '}
{𝟙 : {o : Object} Arrow o o}
{_⊕_ : { a b c : Object } Arrow b c Arrow a b Arrow a c}
where
-- TODO, provable by using arrow-is-set and that isProp (isEquiv _ _ _)
-- This lemma will be useful to prove the equality of two categories.
IsCategory-is-prop : isProp (IsCategory Object Arrow 𝟙 _⊕_)
IsCategory-is-prop = {!!}
-- open IsCategory public -- open IsCategory public
record Category ( ' : Level) : Set (lsuc (' )) where record Category ( ' : Level) : Set (lsuc (' )) where
-- adding no-eta-equality can speed up type-checking. -- adding no-eta-equality can speed up type-checking.
-- ONLY IF you define your categories with copatterns though.
no-eta-equality no-eta-equality
field field
Object : Set Object : Set
@ -53,20 +90,16 @@ record Category ( ' : Level) : Set (lsuc (' ⊔ )) where
open Category open Category
open IsCategory using (Isomorphism; _≅_)
module _ { ' : Level} { : Category '} where module _ { ' : Level} { : Category '} where
module _ { A B : .Object } where module _ { A B : .Object } where
Isomorphism : (f : .Arrow A B) Set '
Isomorphism f = Σ[ g .Arrow B A ] ._⊕_ g f .𝟙 × ._⊕_ f g .𝟙
Epimorphism : {X : .Object } (f : .Arrow A B) Set ' Epimorphism : {X : .Object } (f : .Arrow A B) Set '
Epimorphism {X} f = ( g₀ g₁ : .Arrow B X ) ._⊕_ g₀ f ._⊕_ g₁ f g₀ g₁ Epimorphism {X} f = ( g₀ g₁ : .Arrow B X ) ._⊕_ g₀ f ._⊕_ g₁ f g₀ g₁
Monomorphism : {X : .Object} (f : .Arrow A B) Set ' Monomorphism : {X : .Object} (f : .Arrow A B) Set '
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₁
-- Isomorphism of objects
_≅_ : (A B : Object ) Set '
_≅_ A B = Σ[ f .Arrow A B ] (Isomorphism f)
module _ { ' : Level} ( : Category ') {A B obj : Object } where module _ { ' : Level} ( : Category ') {A B obj : Object } where
IsProduct : (π₁ : Arrow obj A) (π₂ : Arrow obj B) Set ( ') IsProduct : (π₁ : Arrow obj A) (π₂ : Arrow obj B) Set ( ')
@ -117,7 +150,9 @@ module _ { ' : Level} ( : Category ') where
; Arrow = flip ( .Arrow) ; Arrow = flip ( .Arrow)
; 𝟙 = .𝟙 ; 𝟙 = .𝟙
; _⊕_ = flip ( ._⊕_) ; _⊕_ = flip ( ._⊕_)
; isCategory = record { assoc = sym assoc ; ident = swap ident } ; isCategory = record { assoc = sym assoc ; ident = swap ident
; arrow-is-set = {!!}
; univalent = {!!} }
} }
where where
open IsCategory ( .isCategory) open IsCategory ( .isCategory)