Stuff about propositionality of fields of IsCategory

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-19 15:46:19 +01:00
parent bec5acdc59
commit 44eda0ced0
2 changed files with 82 additions and 25 deletions

View file

@ -26,15 +26,9 @@ open import Cat.Wishlist
syntax ∃!-syntax (λ x B) = ∃![ x ] B
record RawCategory ( ' : Level) : Set (lsuc (' )) where
-- adding no-eta-equality can speed up type-checking.
-- ONLY IF you define your categories with copatterns though.
no-eta-equality
field
-- Need something like:
-- Object : Σ (Set ) isGroupoid
Object : Set
-- And:
-- Arrow : Object → Object → Σ (Set ') isSet
Arrow : Object Object Set '
𝟙 : {o : Object} Arrow o o
_∘_ : {A B C : Object} Arrow B C Arrow A B Arrow A C
@ -53,15 +47,48 @@ record RawCategory ( ' : Level) : Set (lsuc (' ⊔ )) where
record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc (a b)) where
open RawCategory
module Raw = RawCategory
field
assoc : {A B C D : Object} { f : Arrow A B } { g : Arrow B C } { h : Arrow C D }
IsAssociative : Set (a b)
IsAssociative = {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
h (g f) (h g) f
ident : {A B : Object} {f : Arrow A B}
f 𝟙 f × 𝟙 f f
IsIdentity : ({A : Object} Arrow A A) Set (a b)
IsIdentity id = {A B : Object} {f : Arrow A B}
f id f × id f f
field
assoc : IsAssociative
ident : IsIdentity 𝟙
arrowIsSet : {A B : Object} isSet (Arrow A B)
propIsAssociative : isProp IsAssociative
propIsAssociative x y i = arrowIsSet _ _ x y i
propIsIdentity : {f : {A} Arrow A A} isProp (IsIdentity f)
propIsIdentity a b i
= arrowIsSet _ _ (fst a) (fst b) i
, arrowIsSet _ _ (snd a) (snd b) i
propArrowIsSet : isProp ( {A B} isSet (Arrow A B))
propArrowIsSet a b i = isSetIsProp a b i
IsInverseOf : {A B} (Arrow A B) (Arrow B A) Set b
IsInverseOf = λ f g g f 𝟙 × f g 𝟙
propIsInverseOf : {A B f g} isProp (IsInverseOf {A} {B} f g)
propIsInverseOf x y = λ i
let
h : fst x fst y
h = arrowIsSet _ _ (fst x) (fst y)
hh : snd x snd y
hh = arrowIsSet _ _ (snd x) (snd y)
in h i , hh i
Isomorphism : {A B} (f : Arrow A B) Set b
Isomorphism {A} {B} f = Σ[ g Arrow B A ] g f 𝟙 × f g 𝟙
Isomorphism {A} {B} f = Σ[ g Arrow B A ] IsInverseOf f g
inverse : {A B} {f : Arrow A B} Isomorphism f Arrow B A
inverse iso = fst iso
_≅_ : (A B : Object) Set b
_≅_ A B = Σ[ f Arrow A B ] (Isomorphism f)
@ -86,19 +113,40 @@ record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc
Monomorphism : {X : Object} (f : Arrow A B) Set b
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) f g₀ f g₁ g₀ g₁
module _ {A B : Object} {f : Arrow A B} where
isoIsProp : isProp (Isomorphism f)
isoIsProp a@(g , η , ε) a'@(g' , η' , ε') =
lemSig (λ g propIsInverseOf) a a' geq
where
open Cubical.NType.Properties
geq : g g'
geq = begin
g ≡⟨ sym (fst ident)
g 𝟙 ≡⟨ cong (λ φ g φ) (sym ε')
g (f g') ≡⟨ assoc
(g f) g' ≡⟨ cong (λ φ φ g') η
𝟙 g' ≡⟨ snd ident
g'
module _ {a b : Level} {C : RawCategory a b} { : IsCategory C} where
open IsCategory
open import Cubical.NType
open import Cubical.NType.Properties
propUnivalent : isProp Univalent
propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i
module _ {a} {b} { : RawCategory a b} 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 )
IsCategory-is-prop x y i = record
-- Why choose `x`'s `arrowIsSet`?
{ assoc = x.arrowIsSet _ _ x.assoc y.assoc i
; ident =
( x.arrowIsSet _ _ (fst x.ident) (fst y.ident) i
, x.arrowIsSet _ _ (snd x.ident) (snd y.ident) i
)
; arrowIsSet = isSetIsProp x.arrowIsSet y.arrowIsSet i
; univalent = {!!}
-- Why choose `x`'s `propIsAssociative`?
-- Well, probably it could be pulled out of the record.
{ assoc = x.propIsAssociative x.assoc y.assoc i
; ident = x.propIsIdentity x.ident y.ident i
; arrowIsSet = x.propArrowIsSet x.arrowIsSet y.arrowIsSet i
; univalent = eqUni i
}
where
module x = IsCategory x
@ -118,12 +166,17 @@ module _ {a} {b} { : RawCategory a b} where
(λ f Σ-syntax (Arrow (A≡B j) A) (λ g g f 𝟙 × f g 𝟙)))
( 𝟙
, 𝟙
, x.arrowIsSet _ _ (fst x.ident) (fst y.ident) i
, x.arrowIsSet _ _ (snd x.ident) (snd y.ident) i
, x.propIsIdentity x.ident y.ident i
)
)
open Cubical.NType.Properties
test : (λ _ x.Univalent) [ xuni xuni ]
test = refl
t = {!!}
P : (uni : x.Univalent) xuni uni Set (a b)
P = {!!}
eqUni : T [ xuni yuni ]
eqUni = {!!}
eqUni = pathJprop {x = x.Univalent} P {!!} i
record Category (a b : Level) : Set (lsuc (a b)) where

View file

@ -6,6 +6,10 @@ open import Data.Nat using (_≤_ ; z≤n ; s≤s)
postulate ntypeCommulative : { n m} {A : Set } n m HasLevel n ⟩₋₂ A HasLevel m ⟩₋₂ A
-- This follows from [HoTT-book: §7.1.10]
-- Andrea says the proof is in `cubical` but I can't find it.
postulate isSetIsProp : { : Level} {A : Set } isProp (isSet A)
module _ { : Level} {A : Set } where
-- This is §7.1.10 in [HoTT]. Andrea says the proof is in `cubical` but I
-- can't find it.
postulate propHasLevel : n isProp (HasLevel n A)
isSetIsProp : isProp (isSet A)
isSetIsProp = propHasLevel (S (S ⟨-2⟩))