Split Category into RawCategory and IsCategory
This commit is contained in:
parent
fecb4dc1ce
commit
22a9a71870
|
|
@ -12,7 +12,7 @@ open import Function
|
|||
open import Relation.Nullary
|
||||
open import Relation.Nullary.Decidable
|
||||
|
||||
open import Cat.Category hiding (Hom)
|
||||
open import Cat.Category
|
||||
open import Cat.Functor
|
||||
open import Cat.Equality
|
||||
open Equality.Data.Product
|
||||
|
|
@ -66,12 +66,14 @@ module _ {ℓ ℓ' : Level} (Ns : Set ℓ) where
|
|||
Hom = Σ Hom' rules
|
||||
|
||||
-- The category of names and substitutions
|
||||
ℂ : Category ℓ ℓ -- ℓo (lsuc lzero ⊔ ℓo)
|
||||
ℂ = record
|
||||
Rawℂ : RawCategory ℓ ℓ -- ℓo (lsuc lzero ⊔ ℓo)
|
||||
Rawℂ = record
|
||||
{ Object = FiniteDecidableSubset
|
||||
-- { Object = Ns → Bool
|
||||
; Arrow = Hom
|
||||
; 𝟙 = λ { {o} → inj₁ , λ { (i , ii) (j , jj) eq → Σ≡ eq {!refl!} } }
|
||||
; _∘_ = {!!}
|
||||
; isCategory = {!!}
|
||||
}
|
||||
postulate RawIsCategoryℂ : IsCategory Rawℂ
|
||||
ℂ : Category ℓ ℓ
|
||||
ℂ = Rawℂ , RawIsCategoryℂ
|
||||
|
|
|
|||
|
|
@ -13,36 +13,42 @@ open Equality.Data.Product
|
|||
|
||||
module _ (ℓa ℓb : Level) where
|
||||
private
|
||||
Obj = Σ[ A ∈ Set ℓa ] (A → Set ℓb)
|
||||
Arr : Obj → Obj → Set (ℓa ⊔ ℓb)
|
||||
Obj' = Σ[ A ∈ Set ℓa ] (A → Set ℓb)
|
||||
Arr : Obj' → Obj' → Set (ℓa ⊔ ℓb)
|
||||
Arr (A , B) (A' , B') = Σ[ f ∈ (A → A') ] ({x : A} → B x → B' (f x))
|
||||
one : {o : Obj} → Arr o o
|
||||
one : {o : Obj'} → Arr o o
|
||||
proj₁ one = λ x → x
|
||||
proj₂ one = λ b → b
|
||||
_∘_ : {a b c : Obj} → Arr b c → Arr a b → Arr a c
|
||||
_∘_ : {a b c : Obj'} → Arr b c → Arr a b → Arr a c
|
||||
(g , g') ∘ (f , f') = g Function.∘ f , g' Function.∘ f'
|
||||
_⟨_∘_⟩ : {a b : Obj} → (c : Obj) → Arr b c → Arr a b → Arr a c
|
||||
_⟨_∘_⟩ : {a b : Obj'} → (c : Obj') → Arr b c → Arr a b → Arr a c
|
||||
c ⟨ g ∘ f ⟩ = _∘_ {c = c} g f
|
||||
|
||||
module _ {A B C D : Obj} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
|
||||
module _ {A B C D : Obj'} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
|
||||
assoc : (D ⟨ h ∘ C ⟨ g ∘ f ⟩ ⟩) ≡ D ⟨ D ⟨ h ∘ g ⟩ ∘ f ⟩
|
||||
assoc = Σ≡ refl refl
|
||||
|
||||
module _ {A B : Obj} {f : Arr A B} where
|
||||
module _ {A B : Obj'} {f : Arr A B} where
|
||||
ident : B ⟨ f ∘ one ⟩ ≡ f × B ⟨ one {B} ∘ f ⟩ ≡ f
|
||||
ident = (Σ≡ refl refl) , Σ≡ refl refl
|
||||
|
||||
|
||||
RawFam : RawCategory (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||
RawFam = record
|
||||
{ Object = Obj'
|
||||
; Arrow = Arr
|
||||
; 𝟙 = one
|
||||
; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
|
||||
}
|
||||
|
||||
instance
|
||||
isCategory : IsCategory Obj Arr one (λ {a b c} → _∘_ {a} {b} {c})
|
||||
isCategory : IsCategory RawFam
|
||||
isCategory = record
|
||||
{ assoc = λ {A} {B} {C} {D} {f} {g} {h} → assoc {D = D} {f} {g} {h}
|
||||
; ident = λ {A} {B} {f} → ident {A} {B} {f = f}
|
||||
; arrow-is-set = ?
|
||||
; univalent = ?
|
||||
}
|
||||
|
||||
Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
|
||||
Fam = record
|
||||
{ Object = Obj
|
||||
; Arrow = Arr
|
||||
; 𝟙 = one
|
||||
; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
|
||||
}
|
||||
Fam = RawFam , isCategory
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
|
|||
𝔻 [ F→ f ∘ identityTrans F A ] ∎
|
||||
where
|
||||
F→ = F .func→
|
||||
module 𝔻 = IsCategory (𝔻 .isCategory)
|
||||
module 𝔻 = IsCategory (isCategory 𝔻)
|
||||
|
||||
identityNat : (F : Functor ℂ 𝔻) → NaturalTransformation F F
|
||||
identityNat F = identityTrans F , identityNatural F
|
||||
|
|
@ -75,7 +75,7 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
|
|||
𝔻 [ H .func→ f ∘ 𝔻 [ θ A ∘ η A ] ] ≡⟨⟩
|
||||
𝔻 [ H .func→ f ∘ (θ ∘nt η) A ] ∎
|
||||
where
|
||||
open IsCategory (𝔻 .isCategory)
|
||||
open IsCategory (isCategory 𝔻)
|
||||
|
||||
NatComp = _:⊕:_
|
||||
|
||||
|
|
@ -96,29 +96,33 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
|
|||
× (_:⊕:_ {A} {B} {B} (identityNat B) f) ≡ f
|
||||
:ident: = ident-r , ident-l
|
||||
|
||||
instance
|
||||
:isCategory: : IsCategory (Functor ℂ 𝔻) NaturalTransformation
|
||||
(λ {F} → identityNat F) (λ {a} {b} {c} → _:⊕:_ {a} {b} {c})
|
||||
:isCategory: = record
|
||||
{ assoc = λ {A B C D} → :assoc: {A} {B} {C} {D}
|
||||
; ident = λ {A B} → :ident: {A} {B}
|
||||
}
|
||||
|
||||
-- Functor categories. Objects are functors, arrows are natural transformations.
|
||||
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||
Fun = record
|
||||
RawFun : RawCategory (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||
RawFun = record
|
||||
{ Object = Functor ℂ 𝔻
|
||||
; Arrow = NaturalTransformation
|
||||
; 𝟙 = λ {F} → identityNat F
|
||||
; _∘_ = λ {F G H} → _:⊕:_ {F} {G} {H}
|
||||
}
|
||||
|
||||
instance
|
||||
:isCategory: : IsCategory RawFun
|
||||
:isCategory: = record
|
||||
{ assoc = λ {A B C D} → :assoc: {A} {B} {C} {D}
|
||||
; ident = λ {A B} → :ident: {A} {B}
|
||||
; arrow-is-set = ?
|
||||
; univalent = ?
|
||||
}
|
||||
|
||||
Fun : Category (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') (ℓc ⊔ ℓc' ⊔ ℓd')
|
||||
Fun = RawFun , :isCategory:
|
||||
|
||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
||||
open import Cat.Categories.Sets
|
||||
|
||||
-- Restrict the functors to Presheafs.
|
||||
Presh : Category (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||
Presh = record
|
||||
RawPresh : RawCategory (ℓ ⊔ lsuc ℓ') (ℓ ⊔ ℓ')
|
||||
RawPresh = record
|
||||
{ Object = Presheaf ℂ
|
||||
; Arrow = NaturalTransformation
|
||||
; 𝟙 = λ {F} → identityNat F
|
||||
|
|
|
|||
|
|
@ -154,16 +154,18 @@ module _ {A B C D : Set} {S : Subset (A × B)} {R : Subset (B × C)} {Q : Subset
|
|||
≡ (Σ[ b ∈ B ] (a , b) ∈ S × (Σ[ c ∈ C ] (b , c) ∈ R × (c , d) ∈ Q))
|
||||
is-assoc = equivToPath equi
|
||||
|
||||
Rel : Category (lsuc lzero) (lsuc lzero)
|
||||
Rel = record
|
||||
RawRel : RawCategory (lsuc lzero) (lsuc lzero)
|
||||
RawRel = record
|
||||
{ Object = Set
|
||||
; Arrow = λ S R → Subset (S × R)
|
||||
; 𝟙 = λ {S} → Diag S
|
||||
; _∘_ = λ {A B C} S R → λ {( a , c ) → Σ[ b ∈ B ] ( (a , b) ∈ R × (b , c) ∈ S )}
|
||||
; isCategory = record
|
||||
{ assoc = funExt is-assoc
|
||||
; ident = funExt ident-l , funExt ident-r
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
}
|
||||
|
||||
RawIsCategoryRel : IsCategory RawRel
|
||||
RawIsCategoryRel = record
|
||||
{ assoc = funExt is-assoc
|
||||
; ident = funExt ident-l , funExt ident-r
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,22 +4,31 @@ module Cat.Categories.Sets where
|
|||
open import Cubical
|
||||
open import Agda.Primitive
|
||||
open import Data.Product
|
||||
import Function
|
||||
|
||||
open import Cat.Category
|
||||
open import Cat.Functor
|
||||
open Category
|
||||
|
||||
module _ {ℓ : Level} where
|
||||
Sets : Category (lsuc ℓ) ℓ
|
||||
Sets = record
|
||||
{ Object = Set ℓ
|
||||
; Arrow = λ T U → T → U
|
||||
; 𝟙 = id
|
||||
; _∘_ = _∘′_
|
||||
; isCategory = record { assoc = refl ; ident = funExt (λ _ → refl) , funExt (λ _ → refl) }
|
||||
SetsRaw : RawCategory (lsuc ℓ) ℓ
|
||||
SetsRaw = record
|
||||
{ Object = Set ℓ
|
||||
; Arrow = λ T U → T → U
|
||||
; 𝟙 = Function.id
|
||||
; _∘_ = Function._∘′_
|
||||
}
|
||||
|
||||
SetsIsCategory : IsCategory SetsRaw
|
||||
SetsIsCategory = record
|
||||
{ assoc = refl
|
||||
; ident = funExt (λ _ → refl) , funExt (λ _ → refl)
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
where
|
||||
open import Function
|
||||
|
||||
Sets : Category (lsuc ℓ) ℓ
|
||||
Sets = SetsRaw , SetsIsCategory
|
||||
|
||||
private
|
||||
module _ {X A B : Set ℓ} (f : X → A) (g : X → B) where
|
||||
|
|
@ -55,7 +64,7 @@ representable {ℂ = ℂ} A = record
|
|||
}
|
||||
}
|
||||
where
|
||||
open IsCategory (ℂ .isCategory)
|
||||
open IsCategory (isCategory ℂ)
|
||||
|
||||
-- Contravariant Presheaf
|
||||
Presheaf : ∀ {ℓ ℓ'} (ℂ : Category ℓ ℓ') → Set (ℓ ⊔ lsuc ℓ')
|
||||
|
|
@ -72,4 +81,4 @@ presheaf {ℂ = ℂ} B = record
|
|||
}
|
||||
}
|
||||
where
|
||||
open IsCategory (ℂ .isCategory)
|
||||
open IsCategory (isCategory ℂ)
|
||||
|
|
|
|||
|
|
@ -23,18 +23,37 @@ open import Cubical.GradLemma using ( propIsEquiv )
|
|||
|
||||
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
|
||||
infixl 10 _∘_
|
||||
domain : { a b : Object } → Arrow a b → Object
|
||||
domain {a = a} _ = a
|
||||
codomain : { a b : Object } → Arrow a b → Object
|
||||
codomain {b = b} _ = 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 {ℓ ℓ' : Level}
|
||||
(Object : Set ℓ)
|
||||
(Arrow : Object → Object → Set ℓ')
|
||||
(𝟙 : {o : Object} → Arrow o o)
|
||||
(_∘_ : { a b c : Object } → Arrow b c → Arrow a b → Arrow a c)
|
||||
: Set (lsuc (ℓ' ⊔ ℓ)) where
|
||||
record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc (ℓa ⊔ ℓb)) where
|
||||
open RawCategory ℂ
|
||||
-- (Object : Set ℓ)
|
||||
-- (Arrow : Object → Object → Set ℓ')
|
||||
-- (𝟙 : {o : Object} → Arrow o o)
|
||||
-- (_∘_ : { a b c : Object } → Arrow b c → Arrow a b → Arrow a c)
|
||||
field
|
||||
assoc : {A B C D : Object} { f : Arrow A B } { g : Arrow B C } { h : Arrow C D }
|
||||
→ h ∘ (g ∘ f) ≡ (h ∘ g) ∘ f
|
||||
|
|
@ -42,10 +61,10 @@ record IsCategory {ℓ ℓ' : Level}
|
|||
→ 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 : Arrow A B) → Set ℓb
|
||||
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] g ∘ f ≡ 𝟙 × f ∘ g ≡ 𝟙
|
||||
|
||||
_≅_ : (A B : Object) → Set ℓ'
|
||||
_≅_ : (A B : Object) → Set ℓb
|
||||
_≅_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
||||
|
||||
idIso : (A : Object) → A ≅ A
|
||||
|
|
@ -61,20 +80,16 @@ record IsCategory {ℓ ℓ' : Level}
|
|||
univalent : {A B : Object} → isEquiv (A ≡ B) (A ≅ B) (id-to-iso A B)
|
||||
|
||||
module _ {A B : Object} where
|
||||
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓ'
|
||||
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓb
|
||||
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 ℓb
|
||||
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) → f ∘ g₀ ≡ f ∘ g₁ → g₀ ≡ g₁
|
||||
|
||||
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
|
||||
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 Object Arrow 𝟙 _⊕_)
|
||||
IsCategory-is-prop : isProp (IsCategory ℂ)
|
||||
IsCategory-is-prop x y i = record
|
||||
{ assoc = x.arrow-is-set _ _ x.assoc y.assoc i
|
||||
; ident =
|
||||
|
|
@ -94,38 +109,32 @@ module _ {ℓ} {ℓ'} {Object : Set ℓ}
|
|||
module x = IsCategory x
|
||||
module y = IsCategory y
|
||||
|
||||
record Category (ℓ ℓ' : 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
|
||||
{{isCategory}} : IsCategory Object Arrow 𝟙 _∘_
|
||||
infixl 10 _∘_
|
||||
domain : { a b : Object } → Arrow a b → Object
|
||||
domain {a = a} _ = a
|
||||
codomain : { a b : Object } → Arrow a b → Object
|
||||
codomain {b = b} _ = b
|
||||
Category : (ℓa ℓb : Level) → Set (lsuc (ℓa ⊔ ℓb))
|
||||
Category ℓa ℓb = Σ (RawCategory ℓa ℓb) IsCategory
|
||||
|
||||
open Category
|
||||
module Category {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||
raw = fst ℂ
|
||||
open RawCategory raw public
|
||||
isCategory = snd ℂ
|
||||
|
||||
_[_,_] : ∀ {ℓ ℓ'} → (ℂ : Category ℓ ℓ') → (A : ℂ .Object) → (B : ℂ .Object) → Set ℓ'
|
||||
_[_,_] = Arrow
|
||||
open RawCategory
|
||||
|
||||
_[_∘_] : ∀ {ℓ ℓ'} → (ℂ : Category ℓ ℓ') → {A B C : ℂ .Object} → (g : ℂ [ B , C ]) → (f : ℂ [ A , B ]) → ℂ [ A , C ]
|
||||
_[_∘_] = _∘_
|
||||
-- _∈_ : ∀ {ℓa ℓb} (ℂ : Category ℓa ℓb) → (ℂ .fst .Object → Set ℓb) → Set (ℓa ⊔ ℓb)
|
||||
-- A ∈ ℂ =
|
||||
|
||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Object ℂ} where
|
||||
IsProduct : (π₁ : Arrow ℂ obj A) (π₂ : Arrow ℂ obj B) → Set (ℓ ⊔ ℓ')
|
||||
Obj : ∀ {ℓa ℓb} → Category ℓa ℓb → Set ℓa
|
||||
Obj ℂ = ℂ .fst .Object
|
||||
|
||||
_[_,_] : ∀ {ℓ ℓ'} → (ℂ : Category ℓ ℓ') → (A : Obj ℂ) → (B : Obj ℂ) → Set ℓ'
|
||||
ℂ [ A , B ] = ℂ .fst .Arrow A B
|
||||
|
||||
_[_∘_] : ∀ {ℓ ℓ'} → (ℂ : Category ℓ ℓ') → {A B C : Obj ℂ} → (g : ℂ [ B , C ]) → (f : ℂ [ A , B ]) → ℂ [ A , C ]
|
||||
ℂ [ g ∘ f ] = ℂ .fst ._∘_ g f
|
||||
|
||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Obj ℂ} where
|
||||
IsProduct : (π₁ : ℂ [ obj , A ]) (π₂ : ℂ [ obj , B ]) → Set (ℓ ⊔ ℓ')
|
||||
IsProduct π₁ π₂
|
||||
= ∀ {X : ℂ .Object} (x₁ : ℂ .Arrow X A) (x₂ : ℂ .Arrow X B)
|
||||
= ∀ {X : Obj ℂ} (x₁ : ℂ [ X , A ]) (x₂ : ℂ [ X , B ])
|
||||
→ ∃![ x ] (ℂ [ π₁ ∘ x ] ≡ x₁ × ℂ [ π₂ ∘ x ] ≡ x₂)
|
||||
|
||||
-- Tip from Andrea; Consider this style for efficiency:
|
||||
|
|
@ -135,48 +144,55 @@ module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Object ℂ} whe
|
|||
-- isProduct : ∀ {X : ℂ .Object} (x₁ : ℂ .Arrow X A) (x₂ : ℂ .Arrow X B)
|
||||
-- → ∃![ x ] (ℂ ._⊕_ π₁ x ≡ x₁ × ℂ. _⊕_ π₂ x ≡ x₂)
|
||||
|
||||
record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : ℂ .Object) : Set (ℓ ⊔ ℓ') where
|
||||
record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : Obj ℂ) : Set (ℓ ⊔ ℓ') where
|
||||
no-eta-equality
|
||||
field
|
||||
obj : ℂ .Object
|
||||
proj₁ : ℂ .Arrow obj A
|
||||
proj₂ : ℂ .Arrow obj B
|
||||
obj : Obj ℂ
|
||||
proj₁ : ℂ [ obj , A ]
|
||||
proj₂ : ℂ [ obj , B ]
|
||||
{{isProduct}} : IsProduct ℂ proj₁ proj₂
|
||||
|
||||
arrowProduct : ∀ {X} → (π₁ : Arrow ℂ X A) (π₂ : Arrow ℂ X B)
|
||||
→ Arrow ℂ X obj
|
||||
arrowProduct : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
|
||||
→ ℂ [ X , obj ]
|
||||
arrowProduct π₁ π₂ = fst (isProduct π₁ π₂)
|
||||
|
||||
record HasProducts {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where
|
||||
field
|
||||
product : ∀ (A B : ℂ .Object) → Product {ℂ = ℂ} A B
|
||||
product : ∀ (A B : Obj ℂ) → Product {ℂ = ℂ} A B
|
||||
|
||||
open Product
|
||||
|
||||
objectProduct : (A B : ℂ .Object) → ℂ .Object
|
||||
objectProduct : (A B : Obj ℂ) → Obj ℂ
|
||||
objectProduct A B = Product.obj (product A B)
|
||||
-- The product mentioned in awodey in Def 6.1 is not the regular product of arrows.
|
||||
-- It's a "parallel" product
|
||||
parallelProduct : {A A' B B' : ℂ .Object} → ℂ .Arrow A A' → ℂ .Arrow B B'
|
||||
→ ℂ .Arrow (objectProduct A B) (objectProduct A' B')
|
||||
parallelProduct : {A A' B B' : Obj ℂ} → ℂ [ A , A' ] → ℂ [ B , B' ]
|
||||
→ ℂ [ objectProduct A B , objectProduct A' B' ]
|
||||
parallelProduct {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B')
|
||||
(ℂ [ a ∘ (product A B) .proj₁ ])
|
||||
(ℂ [ b ∘ (product A B) .proj₂ ])
|
||||
|
||||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
||||
Opposite : Category ℓ ℓ'
|
||||
Opposite =
|
||||
record
|
||||
{ Object = ℂ .Object
|
||||
; Arrow = Function.flip (ℂ .Arrow)
|
||||
; 𝟙 = ℂ .𝟙
|
||||
; _∘_ = Function.flip (ℂ ._∘_)
|
||||
; isCategory = record { assoc = sym assoc ; ident = swap ident
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!} }
|
||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||
private
|
||||
open Category ℂ
|
||||
module ℂ = RawCategory (ℂ .fst)
|
||||
OpRaw : RawCategory ℓa ℓb
|
||||
OpRaw = record
|
||||
{ Object = ℂ.Object
|
||||
; Arrow = Function.flip ℂ.Arrow
|
||||
; 𝟙 = ℂ.𝟙
|
||||
; _∘_ = Function.flip (ℂ._∘_)
|
||||
}
|
||||
where
|
||||
open IsCategory (ℂ .isCategory)
|
||||
open IsCategory isCategory
|
||||
OpIsCategory : IsCategory OpRaw
|
||||
OpIsCategory = record
|
||||
{ assoc = sym assoc
|
||||
; ident = swap ident
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
Opposite : Category ℓa ℓb
|
||||
Opposite = OpRaw , OpIsCategory
|
||||
|
||||
-- A consequence of no-eta-equality; `Opposite-is-involution` is no longer
|
||||
-- definitional - i.e.; you must match on the fields:
|
||||
|
|
@ -189,42 +205,34 @@ module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
|||
-- assoc (Opposite-is-involution i) = {!!}
|
||||
-- ident (Opposite-is-involution i) = {!!}
|
||||
|
||||
Hom : {ℓ ℓ' : Level} → (ℂ : Category ℓ ℓ') → (A B : Object ℂ) → Set ℓ'
|
||||
Hom ℂ A B = Arrow ℂ A B
|
||||
|
||||
module _ {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} where
|
||||
HomFromArrow : (A : ℂ .Object) → {B B' : ℂ .Object} → (g : ℂ .Arrow B B')
|
||||
→ Hom ℂ A B → Hom ℂ A B'
|
||||
HomFromArrow _A = ℂ ._∘_
|
||||
|
||||
module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where
|
||||
open HasProducts hasProducts
|
||||
open Product hiding (obj)
|
||||
private
|
||||
_×p_ : (A B : ℂ .Object) → ℂ .Object
|
||||
_×p_ : (A B : Obj ℂ) → Obj ℂ
|
||||
_×p_ A B = Product.obj (product A B)
|
||||
|
||||
module _ (B C : ℂ .Category.Object) where
|
||||
IsExponential : (Cᴮ : ℂ .Object) → ℂ .Arrow (Cᴮ ×p B) C → Set (ℓ ⊔ ℓ')
|
||||
IsExponential Cᴮ eval = ∀ (A : ℂ .Object) (f : ℂ .Arrow (A ×p B) C)
|
||||
→ ∃![ f~ ] (ℂ [ eval ∘ parallelProduct f~ (ℂ .𝟙)] ≡ f)
|
||||
module _ (B C : Obj ℂ) where
|
||||
IsExponential : (Cᴮ : Obj ℂ) → ℂ [ Cᴮ ×p B , C ] → Set (ℓ ⊔ ℓ')
|
||||
IsExponential Cᴮ eval = ∀ (A : Obj ℂ) (f : ℂ [ A ×p B , C ])
|
||||
→ ∃![ f~ ] (ℂ [ eval ∘ parallelProduct f~ (Category.raw ℂ .𝟙)] ≡ f)
|
||||
|
||||
record Exponential : Set (ℓ ⊔ ℓ') where
|
||||
field
|
||||
-- obj ≡ Cᴮ
|
||||
obj : ℂ .Object
|
||||
eval : ℂ .Arrow ( obj ×p B ) C
|
||||
obj : Obj ℂ
|
||||
eval : ℂ [ obj ×p B , C ]
|
||||
{{isExponential}} : IsExponential obj eval
|
||||
-- If I make this an instance-argument then the instance resolution
|
||||
-- algorithm goes into an infinite loop. Why?
|
||||
exponentialsHaveProducts : HasProducts ℂ
|
||||
exponentialsHaveProducts = hasProducts
|
||||
transpose : (A : ℂ .Object) → ℂ .Arrow (A ×p B) C → ℂ .Arrow A obj
|
||||
transpose : (A : Obj ℂ) → ℂ [ A ×p B , C ] → ℂ [ A , obj ]
|
||||
transpose A f = fst (isExponential A f)
|
||||
|
||||
record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where
|
||||
field
|
||||
exponent : (A B : ℂ .Object) → Exponential ℂ A B
|
||||
exponent : (A B : Obj ℂ) → Exponential ℂ A B
|
||||
|
||||
record CartesianClosed {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where
|
||||
field
|
||||
|
|
@ -234,15 +242,15 @@ record CartesianClosed {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ
|
|||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||
unique = isContr
|
||||
|
||||
IsInitial : ℂ .Object → Set (ℓa ⊔ ℓb)
|
||||
IsInitial I = {X : ℂ .Object} → unique (ℂ .Arrow I X)
|
||||
IsInitial : Obj ℂ → Set (ℓa ⊔ ℓb)
|
||||
IsInitial I = {X : Obj ℂ} → unique (ℂ [ I , X ])
|
||||
|
||||
IsTerminal : ℂ .Object → Set (ℓa ⊔ ℓb)
|
||||
IsTerminal : Obj ℂ → Set (ℓa ⊔ ℓb)
|
||||
-- ∃![ ? ] ?
|
||||
IsTerminal T = {X : ℂ .Object} → unique (ℂ .Arrow X T)
|
||||
IsTerminal T = {X : Obj ℂ} → unique (ℂ [ X , T ])
|
||||
|
||||
Initial : Set (ℓa ⊔ ℓb)
|
||||
Initial = Σ (ℂ .Object) IsInitial
|
||||
Initial = Σ (Obj ℂ) IsInitial
|
||||
|
||||
Terminal : Set (ℓa ⊔ ℓb)
|
||||
Terminal = Σ (ℂ .Object) IsTerminal
|
||||
Terminal = Σ (Obj ℂ) IsTerminal
|
||||
|
|
|
|||
|
|
@ -10,33 +10,33 @@ open import Cat.Category as C
|
|||
module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
|
||||
private
|
||||
open module ℂ = Category ℂ
|
||||
Obj = ℂ.Object
|
||||
|
||||
postulate
|
||||
Path : ( a b : Obj ) → Set ℓ'
|
||||
emptyPath : (o : Obj) → Path o o
|
||||
concatenate : {a b c : Obj} → Path b c → Path a b → Path a c
|
||||
Path : ( a b : Obj ℂ ) → Set ℓ'
|
||||
emptyPath : (o : Obj ℂ) → Path o o
|
||||
concatenate : {a b c : Obj ℂ} → Path b c → Path a b → Path a c
|
||||
|
||||
private
|
||||
module _ {A B C D : Obj} {r : Path A B} {q : Path B C} {p : Path C D} where
|
||||
module _ {A B C D : Obj ℂ} {r : Path A B} {q : Path B C} {p : Path C D} where
|
||||
postulate
|
||||
p-assoc : concatenate {A} {C} {D} p (concatenate {A} {B} {C} q r)
|
||||
≡ concatenate {A} {B} {D} (concatenate {B} {C} {D} p q) r
|
||||
module _ {A B : Obj} {p : Path A B} where
|
||||
module _ {A B : Obj ℂ} {p : Path A B} where
|
||||
postulate
|
||||
ident-r : concatenate {A} {A} {B} p (emptyPath A) ≡ p
|
||||
ident-l : concatenate {A} {B} {B} (emptyPath B) p ≡ p
|
||||
|
||||
Free : Category ℓ ℓ'
|
||||
Free = record
|
||||
{ Object = Obj
|
||||
RawFree : RawCategory ℓ ℓ'
|
||||
RawFree = record
|
||||
{ Object = Obj ℂ
|
||||
; Arrow = Path
|
||||
; 𝟙 = λ {o} → emptyPath o
|
||||
; _∘_ = λ {a b c} → concatenate {a} {b} {c}
|
||||
; isCategory = record
|
||||
{ assoc = p-assoc
|
||||
; ident = ident-r , ident-l
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
}
|
||||
RawIsCategoryFree : IsCategory RawFree
|
||||
RawIsCategoryFree = record
|
||||
{ assoc = p-assoc
|
||||
; ident = ident-r , ident-l
|
||||
; arrow-is-set = {!!}
|
||||
; univalent = {!!}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,11 +10,11 @@ open Category hiding (_∘_)
|
|||
|
||||
module _ {ℓc ℓc' ℓd ℓd'} (ℂ : Category ℓc ℓc') (𝔻 : Category ℓd ℓd') where
|
||||
record IsFunctor
|
||||
(func* : ℂ .Object → 𝔻 .Object)
|
||||
(func→ : {A B : ℂ .Object} → ℂ [ A , B ] → 𝔻 [ func* A , func* B ])
|
||||
(func* : Obj ℂ → Obj 𝔻)
|
||||
(func→ : {A B : Obj ℂ} → ℂ [ A , B ] → 𝔻 [ func* A , func* B ])
|
||||
: Set (ℓc ⊔ ℓc' ⊔ ℓd ⊔ ℓd') where
|
||||
field
|
||||
ident : { c : ℂ .Object } → func→ (ℂ .𝟙 {c}) ≡ 𝔻 .𝟙 {func* c}
|
||||
ident : {c : Obj ℂ} → func→ (ℂ .𝟙 {c}) ≡ 𝔻 .𝟙 {func* c}
|
||||
-- TODO: Avoid use of ugly explicit arguments somehow.
|
||||
-- This guy managed to do it:
|
||||
-- https://github.com/copumpkin/categories/blob/master/Categories/Functor/Core.agda
|
||||
|
|
|
|||
Loading…
Reference in a new issue