Make univalence a submodule of RawCategory

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-20 15:19:28 +01:00
parent b03bfb0c77
commit 811a6bf58e
5 changed files with 26 additions and 24 deletions

View file

@ -97,7 +97,8 @@ module CatProduct { ' : Level} ( 𝔻 : Category ') where
isIdentity isIdentity
= Σ≡ (fst .isIdentity) (fst 𝔻.isIdentity) = Σ≡ (fst .isIdentity) (fst 𝔻.isIdentity)
, Σ≡ (snd .isIdentity) (snd 𝔻.isIdentity) , Σ≡ (snd .isIdentity) (snd 𝔻.isIdentity)
postulate univalent : Univalence.Univalent rawProduct isIdentity
postulate univalent : Univalence.Univalent isIdentity
instance instance
isCategory : IsCategory rawProduct isCategory : IsCategory rawProduct
IsCategory.isAssociative isCategory = Σ≡ .isAssociative 𝔻.isAssociative IsCategory.isAssociative isCategory = Σ≡ .isAssociative 𝔻.isAssociative

View file

@ -35,8 +35,6 @@ module _ {a b : Level} ( : Category a b) where
RawCategory._∘_ RawFree = concatenate RawCategory._∘_ RawFree = concatenate
open RawCategory RawFree open RawCategory RawFree
open Univalence RawFree
isAssociative : {A B C D : .Object} {r : Path .Arrow A B} {q : Path .Arrow B C} {p : Path .Arrow C D} isAssociative : {A B C D : .Object} {r : Path .Arrow A B} {q : Path .Arrow B C} {p : Path .Arrow C D}
p ++ (q ++ r) (p ++ q) ++ r p ++ (q ++ r) (p ++ q) ++ r
@ -59,13 +57,16 @@ module _ {a b : Level} ( : Category a b) where
isIdentity : IsIdentity 𝟙 isIdentity : IsIdentity 𝟙
isIdentity = ident-r , ident-l isIdentity = ident-r , ident-l
open Univalence isIdentity
module _ {A B : .Object} where module _ {A B : .Object} where
arrowsAreSets : Cubical.isSet (Path .Arrow A B) arrowsAreSets : Cubical.isSet (Path .Arrow A B)
arrowsAreSets a b p q = {!!} arrowsAreSets a b p q = {!!}
eqv : isEquiv (A B) (A B) (id-to-iso isIdentity A B) eqv : isEquiv (A B) (A B) (Univalence.id-to-iso isIdentity A B)
eqv = {!!} eqv = {!!}
univalent : Univalent isIdentity
univalent : Univalent
univalent = eqv univalent = eqv
isCategory : IsCategory RawFree isCategory : IsCategory RawFree

View file

@ -67,7 +67,8 @@ module Fun {c c' d d' : Level} ( : Category c c') (𝔻 : C
} }
open RawCategory RawFun open RawCategory RawFun
open Univalence RawFun open Univalence (λ {A} {B} {f} isIdentity {A} {B} {f})
module _ {A B : Functor 𝔻} where module _ {A B : Functor 𝔻} where
module A = Functor A module A = Functor A
module B = Functor B module B = Functor B
@ -145,10 +146,10 @@ module Fun {c c' d d' : Level} ( : Category c c') (𝔻 : C
re-ve : (x : A B) reverse (obverse x) x re-ve : (x : A B) reverse (obverse x) x
re-ve = {!!} re-ve = {!!}
done : isEquiv (A B) (A B) (id-to-iso (λ { {A} {B} isIdentity {A} {B}}) A B) done : isEquiv (A B) (A B) (Univalence.id-to-iso (λ { {A} {B} isIdentity {A} {B}}) A B)
done = {!gradLemma obverse reverse ve-re re-ve!} done = {!gradLemma obverse reverse ve-re re-ve!}
univalent : Univalent (λ{ {A} {B} isIdentity {A} {B}}) univalent : Univalent
univalent = done univalent = done
instance instance

View file

@ -69,12 +69,13 @@ module _ ( : Level) where
RawCategory._∘_ SetsRaw = Function._∘_ RawCategory._∘_ SetsRaw = Function._∘_
open RawCategory SetsRaw hiding (_∘_) open RawCategory SetsRaw hiding (_∘_)
open Univalence SetsRaw
isIdentity : IsIdentity Function.id isIdentity : IsIdentity Function.id
proj₁ isIdentity = funExt λ _ refl proj₁ isIdentity = funExt λ _ refl
proj₂ isIdentity = funExt λ _ refl proj₂ isIdentity = funExt λ _ refl
open Univalence (λ {A} {B} {f} isIdentity {A} {B} {f})
arrowsAreSets : ArrowsAreSets arrowsAreSets : ArrowsAreSets
arrowsAreSets {B = (_ , s)} = setPi λ _ s arrowsAreSets {B = (_ , s)} = setPi λ _ s
@ -266,7 +267,7 @@ module _ ( : Level) where
res : isEquiv (hA hB) (hA hB) (_≃_.eqv t) res : isEquiv (hA hB) (hA hB) (_≃_.eqv t)
res = _≃_.isEqv t res = _≃_.isEqv t
module _ {hA hB : hSet {}} where module _ {hA hB : hSet {}} where
univalent : isEquiv (hA hB) (hA hB) (id-to-iso (λ {A} {B} isIdentity {A} {B}) hA hB) univalent : isEquiv (hA hB) (hA hB) (Univalence.id-to-iso (λ {A} {B} isIdentity {A} {B}) hA hB)
univalent = let k = _≃_.isEqv (sym≃ conclusion) in {!k!} univalent = let k = _≃_.isEqv (sym≃ conclusion) in {!k!}
SetsIsCategory : IsCategory SetsRaw SetsIsCategory : IsCategory SetsRaw

View file

@ -129,12 +129,8 @@ record RawCategory (a b : Level) : Set (lsuc (a ⊔ b)) where
Terminal : Set (a b) Terminal : Set (a b)
Terminal = Σ Object IsTerminal Terminal = Σ Object IsTerminal
-- | Univalence is indexed by a raw category as well as an identity proof. -- | Univalence is indexed by a raw category as well as an identity proof.
-- module Univalence (isIdentity : IsIdentity 𝟙) where
-- FIXME Put this in `RawCategory` and index it on the witness to `isIdentity`.
module Univalence {a b : Level} ( : RawCategory a b) where
open RawCategory
module _ (isIdentity : IsIdentity 𝟙) where
idIso : (A : Object) A A idIso : (A : Object) A A
idIso A = 𝟙 , (𝟙 , isIdentity) idIso A = 𝟙 , (𝟙 , isIdentity)
@ -162,12 +158,13 @@ module Univalence {a b : Level} ( : RawCategory a b) where
-- [HoTT]. -- [HoTT].
record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc (a b)) where record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc (a b)) where
open RawCategory public open RawCategory public
open Univalence public
field field
isAssociative : IsAssociative isAssociative : IsAssociative
isIdentity : IsIdentity 𝟙 isIdentity : IsIdentity 𝟙
arrowsAreSets : ArrowsAreSets arrowsAreSets : ArrowsAreSets
univalent : Univalent isIdentity open Univalence isIdentity public
field
univalent : Univalent
-- Some common lemmas about categories. -- Some common lemmas about categories.
module _ {A B : Object} {X : Object} (f : Arrow A B) where module _ {A B : Object} {X : Object} (f : Arrow A B) where
@ -243,7 +240,7 @@ module Propositionality {a b : Level} ( : RawCategory a b) where
𝟙 g' ≡⟨ snd isIdentity 𝟙 g' ≡⟨ snd isIdentity
g' g'
propUnivalent : isProp (Univalent isIdentity) propUnivalent : isProp Univalent
propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i
private private
@ -251,7 +248,7 @@ module Propositionality {a b : Level} ( : 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 open Univalence
-- 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
@ -336,21 +333,22 @@ module Opposite {a b : Level} where
RawCategory._∘_ opRaw = Function.flip ._∘_ RawCategory._∘_ opRaw = Function.flip ._∘_
open RawCategory opRaw open RawCategory opRaw
open Univalence opRaw
isIdentity : IsIdentity 𝟙 isIdentity : IsIdentity 𝟙
isIdentity = swap .isIdentity isIdentity = swap .isIdentity
open Univalence isIdentity
module _ {A B : .Object} where module _ {A B : .Object} where
univalent : isEquiv (A B) (A B) univalent : isEquiv (A B) (A B)
(id-to-iso (swap .isIdentity) A B) (Univalence.id-to-iso (swap .isIdentity) A B)
fst (univalent iso) = flipFiber (fst (.univalent (flipIso iso))) fst (univalent iso) = flipFiber (fst (.univalent (flipIso iso)))
where where
flipIso : A B B .≅ A flipIso : A B B .≅ A
flipIso (f , f~ , iso) = f , f~ , swap iso flipIso (f , f~ , iso) = f , f~ , swap iso
flipFiber flipFiber
: fiber (.id-to-iso .isIdentity B A) (flipIso iso) : fiber (.id-to-iso B A) (flipIso iso)
fiber ( id-to-iso isIdentity A B) iso fiber ( id-to-iso A B) iso
flipFiber (eq , eqIso) = sym eq , {!!} flipFiber (eq , eqIso) = sym eq , {!!}
snd (univalent iso) = {!!} snd (univalent iso) = {!!}