fredefox/cat
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Further reduce dependency on impossible facts.

Browse source 
Provide the data for the product in the category of categories without
requiring such a category to actually exist
This commit is contained in:
Frederik Hanghøj Iversen 2018-03-05 11:01:36 +01:00
parent 77006011d3
commit 5902c6121b
1 changed files with 98 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
src/Cat/Categories/Cat.agda
View file

@ -62,8 +62,7 @@ module _ (ℓ ℓ' : Level) where
-- The following to some extend depends on the category of categories being a -- The following to some extend depends on the category of categories being a
-- category. In some places it may not actually be needed, however. -- category. In some places it may not actually be needed, however.
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where module CatProducts {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
module _ (ℂ 𝔻 : Category ℓ ℓ') where
private private
:Object: = Object ℂ × Object 𝔻 :Object: = Object ℂ × Object 𝔻
:Arrow: : :Object: → :Object: → Set ℓ' :Arrow: : :Object: → :Object: → Set ℓ'
@ -84,44 +83,45 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
RawCategory._∘_ :rawProduct: = _:⊕:_ RawCategory._∘_ :rawProduct: = _:⊕:_
open RawCategory :rawProduct: open RawCategory :rawProduct:
module C = Category ℂ module ℂ = Category ℂ
module D = Category 𝔻 module 𝔻 = Category 𝔻
open import Cubical.Sigma open import Cubical.Sigma
issSet : {A B : RawCategory.Object :rawProduct:} → isSet (Arrow A B) arrowsAreSets : ArrowsAreSets -- {A B : RawCategory.Object :rawProduct:} → isSet (Arrow A B)
issSet = setSig {sA = C.arrowsAreSets} {sB = λ x → D.arrowsAreSets} arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
ident' : IsIdentity :𝟙: isIdentity : IsIdentity :𝟙:
ident' isIdentity
= Σ≡ (fst C.isIdentity) (fst D.isIdentity) = Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
, Σ≡ (snd C.isIdentity) (snd D.isIdentity) , Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
postulate univalent : Univalence.Univalent :rawProduct: ident' postulate univalent : Univalence.Univalent :rawProduct: isIdentity
instance instance
:isCategory: : IsCategory :rawProduct: :isCategory: : IsCategory :rawProduct:
IsCategory.isAssociative :isCategory: = Σ≡ C.isAssociative D.isAssociative IsCategory.isAssociative :isCategory: = Σ≡ ℂ.isAssociative 𝔻.isAssociative
IsCategory.isIdentity :isCategory: = ident' IsCategory.isIdentity :isCategory: = isIdentity
IsCategory.arrowsAreSets :isCategory: = issSet IsCategory.arrowsAreSets :isCategory: = arrowsAreSets
IsCategory.univalent :isCategory: = univalent IsCategory.univalent :isCategory: = univalent
:product: : Category ℓ ℓ' obj : Category ℓ ℓ'
Category.raw :product: = :rawProduct: Category.raw obj = :rawProduct:
proj₁ : Functor :product: ℂ proj₁ : Functor obj ℂ
proj₁ = record proj₁ = record
{ raw = record { func* = fst ; func→ = fst } { raw = record { func* = fst ; func→ = fst }
; isFunctor = record { isIdentity = refl ; isDistributive = refl } ; isFunctor = record { isIdentity = refl ; isDistributive = refl }
} }
proj₂ : Functor :product: 𝔻 proj₂ : Functor obj 𝔻
proj₂ = record proj₂ = record
{ raw = record { func* = snd ; func→ = snd } { raw = record { func* = snd ; func→ = snd }
; isFunctor = record { isIdentity = refl ; isDistributive = refl } ; isFunctor = record { isIdentity = refl ; isDistributive = refl }
} }
module _ {X : Category ℓ ℓ'} (x₁ : Functor X ℂ) (x₂ : Functor X 𝔻) where module _ {X : Category ℓ ℓ'} (x₁ : Functor X ℂ) (x₂ : Functor X 𝔻) where
x : Functor X :product: private
x : Functor X obj
x = record x = record
{ raw = record { raw = record
{ func* = λ x → x₁.func* x , x₂.func* x { func* = λ x → x₁.func* x , x₂.func* x
; func→ = λ x → func→ x₁ x , func→ x₂ x ; func→ = λ x → x₁.func→ x , x₂.func→ x
} }
; isFunctor = record ; isFunctor = record
{ isIdentity = Σ≡ x₁.isIdentity x₂.isIdentity { isIdentity = Σ≡ x₁.isIdentity x₂.isIdentity
@ -147,27 +147,30 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
isUniq : F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂ isUniq : F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂
isUniq = isUniqL , isUniqR isUniq = isUniqL , isUniqR
uniq : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂) isProduct : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂)
uniq = x , isUniq isProduct = x , isUniq
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
private
Catℓ = Cat ℓ ℓ' unprovable Catℓ = Cat ℓ ℓ' unprovable
module _ (ℂ 𝔻 : Category ℓ ℓ') where
private
module P = CatProducts ℂ 𝔻
instance instance
isProduct : IsProduct Catℓ proj₁ proj₂ isProduct : IsProduct Catℓ P.proj₁ P.proj₂
isProduct = uniq isProduct = P.isProduct
product : Product {ℂ = Catℓ} ℂ 𝔻 product : Product {ℂ = Catℓ} ℂ 𝔻
product = record product = record
{ obj = :product: { obj = P.obj
; proj₁ = proj₁ ; proj₁ = P.proj₁
; proj₂ = proj₂ ; proj₂ = P.proj₂
} }
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
Catt = Cat ℓ ℓ' unprovable
instance instance
hasProducts : HasProducts Catt hasProducts : HasProducts Catℓ
hasProducts = record { product = product unprovable } hasProducts = record { product = product }
-- Basically proves that `Cat ℓ ℓ` is cartesian closed. -- Basically proves that `Cat ℓ ℓ` is cartesian closed.
module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where