Merge branch 'dev'

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-23 12:57:19 +01:00
commit c3b585d03b
12 changed files with 368 additions and 459 deletions

View File

@ -1,6 +1,23 @@
Changelog
=========
Version 1.2.0
-------------
This version is mainly a huge refactor.
I've renamed
* `distrib` to `isDistributive`
* `arrowIsSet` to `arrowsAreSets`
* `ident` to `isIdentity`
* `assoc` to `isAssociative`
And added "type-synonyms" for all of these. Their names should now match their
type. So e.g. `isDistributive` has type `IsDistributive`.
I've also changed how names are exported in `Functor` to be in line with
`Category`.
Version 1.1.0
-------------
In this version categories have been refactored - there's now a notion of a raw

View File

@ -16,107 +16,58 @@ open import Cat.Category.Exponential
open import Cat.Equality
open Equality.Data.Product
open Functor
open IsFunctor
open Category hiding (_∘_)
open Functor using (func→ ; func*)
open Category using (Object ; 𝟙)
-- The category of categories
module _ ( ' : Level) where
private
module _ {𝔸 𝔹 𝔻 : Category '} {F : Functor 𝔸 𝔹} {G : Functor 𝔹 } {H : Functor 𝔻} where
private
eq* : func* (H ∘f (G ∘f F)) func* ((H ∘f G) ∘f F)
eq* = refl
eq→ : PathP
(λ i {A B : Object 𝔸} 𝔸 [ A , B ] 𝔻 [ eq* i A , eq* i B ])
(func→ (H ∘f (G ∘f F))) (func→ ((H ∘f G) ∘f F))
eq→ = refl
postulate
eqI
: (λ i {A : Object 𝔸} eq→ i (𝟙 𝔸 {A}) 𝟙 𝔻 {eq* i A})
[ (H ∘f (G ∘f F)) .isFunctor .ident
((H ∘f G) ∘f F) .isFunctor .ident
]
eqD
: (λ i {A B C} {f : 𝔸 [ A , B ]} {g : 𝔸 [ B , C ]}
eq→ i (𝔸 [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
[ (H ∘f (G ∘f F)) .isFunctor .distrib
((H ∘f G) ∘f F) .isFunctor .distrib
]
assc : H ∘f (G ∘f F) (H ∘f G) ∘f F
assc = Functor≡ eq* eq→ (IsFunctor≡ eqI eqD)
assc = Functor≡ refl refl
module _ { 𝔻 : Category '} {F : Functor 𝔻} where
module _ where
private
eq* : (func* F) (func* (identity {C = })) func* F
eq* = refl
-- lemmm : func→ {C = A} {D = B} (f ∘f identity) ≡ func→ f
eq→ : PathP
(λ i
{x y : Object } Arrow x y Arrow 𝔻 (func* F x) (func* F y))
(func→ (F ∘f identity)) (func→ F)
eq→ = refl
postulate
eqI-r
: (λ i {c : Object } (λ _ 𝔻 [ func* F c , func* F c ])
[ func→ F (𝟙 ) 𝟙 𝔻 ])
[(F ∘f identity) .isFunctor .ident F .isFunctor .ident ]
eqD-r : PathP
(λ i
{A B C : Object } {f : [ A , B ]} {g : [ B , C ]}
eq→ i ( [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
((F ∘f identity) .isFunctor .distrib) (F .isFunctor .distrib)
ident-r : F ∘f identity F
ident-r = Functor≡ eq* eq→ (IsFunctor≡ eqI-r eqD-r)
module _ where
private
postulate
eq* : (identity ∘f F) .func* F .func*
eq→ : PathP
(λ i {x y : Object } [ x , y ] 𝔻 [ eq* i x , eq* i y ])
((identity ∘f F) .func→) (F .func→)
eqI : (λ i {A : Object } eq→ i (𝟙 {A}) 𝟙 𝔻 {eq* i A})
[ ((identity ∘f F) .isFunctor .ident) (F .isFunctor .ident) ]
eqD : PathP (λ i {A B C : Object } {f : [ A , B ]} {g : [ B , C ]}
eq→ i ( [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
((identity ∘f F) .isFunctor .distrib) (F .isFunctor .distrib)
-- (λ z → eq* i z) (eq→ i)
ident-l : identity ∘f F F
ident-l = Functor≡ eq* eq→ λ i record { ident = eqI i ; distrib = eqD i }
ident-r : F ∘f identity F
ident-r = Functor≡ refl refl
RawCat : RawCategory (lsuc ( ')) ( ')
RawCat =
record
{ Object = Category '
; Arrow = Functor
; 𝟙 = identity
; _∘_ = _∘f_
-- What gives here? Why can I not name the variables directly?
-- ; isCategory = record
-- { assoc = λ {_ _ _ _ F G H} → assc {F = F} {G = G} {H = H}
-- ; ident = ident-r , ident-l
-- }
}
open IsCategory
instance
:isCategory: : IsCategory RawCat
assoc :isCategory: {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
ident :isCategory: = ident-r , ident-l
arrow-is-set :isCategory: = {!!}
univalent :isCategory: = {!!}
ident-l : identity ∘f F F
ident-l = Functor≡ refl refl
Cat : Category (lsuc ( ')) ( ')
raw Cat = RawCat
RawCat : RawCategory (lsuc ( ')) ( ')
RawCat =
record
{ Object = Category '
; Arrow = Functor
; 𝟙 = identity
; _∘_ = _∘f_
}
private
open RawCategory RawCat
isAssociative : IsAssociative
isAssociative {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
-- TODO: Rename `ident'` to `ident` after changing how names are exposed in Functor.
ident' : IsIdentity identity
ident' = ident-r , ident-l
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
-- however, form a groupoid! Therefore there is no (1-)category of
-- categories. There does, however, exist a 2-category of 1-categories.
module _ { ' : Level} where
-- Because of the note above there is not category of categories.
Cat : (unprovable : IsCategory RawCat) Category (lsuc ( ')) ( ')
Category.raw (Cat _) = RawCat
Category.isCategory (Cat unprovable) = unprovable
-- Category.raw Cat _ = RawCat
-- Category.isCategory Cat unprovable = unprovable
-- The following to some extend depends on the category of categories being a
-- category. In some places it may not actually be needed, however.
module _ { ' : Level} (unprovable : IsCategory (RawCat ')) where
module _ ( 𝔻 : Category ') where
private
Catt = Cat '
Catt = Cat ' unprovable
:Object: = Object × Object 𝔻
:Arrow: : :Object: :Object: Set '
:Arrow: (c , d) (c' , d') = Arrow c c' × Arrow 𝔻 d d'
:Arrow: (c , d) (c' , d') = [ c , c' ] × 𝔻 [ d , d' ]
:𝟙: : {o : :Object:} :Arrow: o o
:𝟙: = 𝟙 , 𝟙 𝔻
_:⊕:_ :
@ -131,70 +82,67 @@ module _ { ' : Level} where
RawCategory.Arrow :rawProduct: = :Arrow:
RawCategory.𝟙 :rawProduct: = :𝟙:
RawCategory._∘_ :rawProduct: = _:⊕:_
open RawCategory :rawProduct:
module C = IsCategory ( .isCategory)
module D = IsCategory (𝔻 .isCategory)
postulate
issSet : {A B : RawCategory.Object :rawProduct:} isSet (RawCategory.Arrow :rawProduct: A B)
module C = Category
module D = Category 𝔻
open import Cubical.Sigma
issSet : {A B : RawCategory.Object :rawProduct:} isSet (Arrow A B)
issSet = setSig {sA = C.arrowsAreSets} {sB = λ x D.arrowsAreSets}
ident' : IsIdentity :𝟙:
ident'
= Σ≡ (fst C.isIdentity) (fst D.isIdentity)
, Σ≡ (snd C.isIdentity) (snd D.isIdentity)
postulate univalent : Univalence.Univalent :rawProduct: ident'
instance
:isCategory: : IsCategory :rawProduct:
-- :isCategory: = record
-- { assoc = Σ≡ C.assoc D.assoc
-- ; ident
-- = Σ≡ (fst C.ident) (fst D.ident)
-- , Σ≡ (snd C.ident) (snd D.ident)
-- ; arrow-is-set = issSet
-- ; univalent = {!!}
-- }
IsCategory.assoc :isCategory: = Σ≡ C.assoc D.assoc
IsCategory.ident :isCategory:
= Σ≡ (fst C.ident) (fst D.ident)
, Σ≡ (snd C.ident) (snd D.ident)
IsCategory.arrow-is-set :isCategory: = issSet
IsCategory.univalent :isCategory: = {!!}
IsCategory.isAssociative :isCategory: = Σ≡ C.isAssociative D.isAssociative
IsCategory.isIdentity :isCategory: = ident'
IsCategory.arrowsAreSets :isCategory: = issSet
IsCategory.univalent :isCategory: = univalent
:product: : Category '
raw :product: = :rawProduct:
Category.raw :product: = :rawProduct:
proj₁ : Catt [ :product: , ]
proj₁ = record { func* = fst ; func→ = fst ; isFunctor = record { ident = refl ; distrib = refl } }
proj₁ = record
{ raw = record { func* = fst ; func→ = fst }
; isFunctor = record { isIdentity = refl ; isDistributive = refl }
}
proj₂ : Catt [ :product: , 𝔻 ]
proj₂ = record { func* = snd ; func→ = snd ; isFunctor = record { ident = refl ; distrib = refl } }
proj₂ = record
{ raw = record { func* = snd ; func→ = snd }
; isFunctor = record { isIdentity = refl ; isDistributive = refl }
}
module _ {X : Object Catt} (x₁ : Catt [ X , ]) (x₂ : Catt [ X , 𝔻 ]) where
open Functor
x : Functor X :product:
x = record
{ raw = record
{ func* = λ x x₁ .func* x , x₂ .func* x
; func→ = λ x func→ x₁ x , func→ x₂ x
}
; isFunctor = record
{ isIdentity = Σ≡ x₁.isIdentity x₂.isIdentity
; isDistributive = Σ≡ x₁.isDistributive x₂.isDistributive
}
}
where
open module x = Functor x₁
open module x = Functor x₂
postulate x : Functor X :product:
-- x = record
-- { func* = λ x → x₁ .func* x , x₂ .func* x
-- ; func→ = λ x → func→ x₁ x , func→ x₂ x
-- ; isFunctor = record
-- { ident = Σ≡ x₁.ident x₂.ident
-- ; distrib = Σ≡ x₁.distrib x₂.distrib
-- }
-- }
-- where
-- open module x₁ = IsFunctor (x₁ .isFunctor)
-- open module x₂ = IsFunctor (x₂ .isFunctor)
isUniqL : Catt [ proj₁ x ] x₁
isUniqL = Functor≡ eq* eq→
where
eq* : (Catt [ proj₁ x ]) .func* x₁ .func*
eq* = refl
eq→ : (λ i {A : Object X} {B : Object X} X [ A , B ] [ eq* i A , eq* i B ])
[ (Catt [ proj₁ x ]) .func→ x₁ .func→ ]
eq→ = refl
-- Turned into postulate after:
-- > commit e8215b2c051062c6301abc9b3f6ec67106259758 (HEAD -> dev, github/dev)
-- > Author: Frederik Hanghøj Iversen <fhi.1990@gmail.com>
-- > Date: Mon Feb 5 14:59:53 2018 +0100
postulate isUniqL : Catt [ proj₁ x ] x₁
-- isUniqL = Functor≡ eq* eq→ {!!}
-- where
-- eq* : (Catt [ proj₁ ∘ x ]) .func* ≡ x₁ .func*
-- eq* = {!refl!}
-- eq→ : (λ i → {A : Object X} {B : Object X} → X [ A , B ] → [ eq* i A , eq* i B ])
-- [ (Catt [ proj₁ ∘ x ]) .func→ ≡ x₁ .func→ ]
-- eq→ = refl
-- postulate eqIsF : (Catt [ proj₁ ∘ x ]) .isFunctor ≡ x₁ .isFunctor
-- eqIsF = IsFunctor≡ {!refl!} {!!}
postulate isUniqR : Catt [ proj₂ x ] x₂
-- isUniqR = Functor≡ refl refl {!!} {!!}
isUniqR : Catt [ proj₂ x ] x₂
isUniqR = Functor≡ refl refl
isUniq : Catt [ proj₁ x ] x₁ × Catt [ proj₂ x ] x₂
isUniq = isUniqL , isUniqR
@ -203,36 +151,37 @@ module _ { ' : Level} where
uniq = x , isUniq
instance
isProduct : IsProduct (Cat ') proj₁ proj₂
isProduct : IsProduct Catt proj₁ proj₂
isProduct = uniq
product : Product { = (Cat ')} 𝔻
product : Product { = Catt} 𝔻
product = record
{ obj = :product:
; proj₁ = proj₁
; proj₂ = proj₂
}
module _ { ' : Level} where
module _ { ' : Level} (unprovable : IsCategory (RawCat ')) where
Catt = Cat ' unprovable
instance
hasProducts : HasProducts (Cat ')
hasProducts = record { product = product }
hasProducts : HasProducts Catt
hasProducts = record { product = product unprovable }
-- Basically proves that `Cat ` is cartesian closed.
module _ ( : Level) where
module _ ( : Level) (unprovable : IsCategory (RawCat )) where
private
open Data.Product
open import Cat.Categories.Fun
Cat : Category (lsuc ( )) ( )
Cat = Cat
Cat = Cat unprovable
module _ ( 𝔻 : Category ) where
private
:obj: : Object (Cat )
:obj: : Object Cat
:obj: = Fun { = } {𝔻 = 𝔻}
:func*: : Functor 𝔻 × Object Object 𝔻
:func*: (F , A) = F .func* A
:func*: (F , A) = func* F A
module _ {dom cod : Functor 𝔻 × Object } where
private
@ -247,30 +196,30 @@ module _ ( : Level) where
B = proj₂ cod
:func→: : (pobj : NaturalTransformation F G × [ A , B ])
𝔻 [ F .func* A , G .func* B ]
𝔻 [ func* F A , func* G B ]
:func→: ((θ , θNat) , f) = result
where
θA : 𝔻 [ F .func* A , G .func* A ]
θA : 𝔻 [ func* F A , func* G A ]
θA = θ A
θB : 𝔻 [ F .func* B , G .func* B ]
θB : 𝔻 [ func* F B , func* G B ]
θB = θ B
F→f : 𝔻 [ F .func* A , F .func* B ]
F→f = F .func→ f
G→f : 𝔻 [ G .func* A , G .func* B ]
G→f = G .func→ f
l : 𝔻 [ F .func* A , G .func* B ]
F→f : 𝔻 [ func* F A , func* F B ]
F→f = func→ F f
G→f : 𝔻 [ func* G A , func* G B ]
G→f = func→ G f
l : 𝔻 [ func* F A , func* G B ]
l = 𝔻 [ θB F→f ]
r : 𝔻 [ F .func* A , G .func* B ]
r : 𝔻 [ func* F A , func* G B ]
r = 𝔻 [ G→f θA ]
-- There are two choices at this point,
-- but I suppose the whole point is that
-- by `θNat f` we have `l ≡ r`
-- lem : 𝔻 [ θ B ∘ F .func→ f ] ≡ 𝔻 [ G .func→ f ∘ θ A ]
-- lem = θNat f
result : 𝔻 [ F .func* A , G .func* B ]
result : 𝔻 [ func* F A , func* G B ]
result = l
_×p_ = product
_×p_ = product unprovable
module _ {c : Functor 𝔻 × Object } where
private
@ -281,21 +230,21 @@ module _ ( : Level) where
-- NaturalTransformation F G × .Arrow A B
-- :ident: : :func→: {c} {c} (identityNat F , .𝟙) 𝔻 .𝟙
-- :ident: = trans (proj₂ 𝔻.ident) (F .ident)
-- :ident: = trans (proj₂ 𝔻.isIdentity) (F .isIdentity)
-- where
-- open module 𝔻 = IsCategory (𝔻 .isCategory)
-- Unfortunately the equational version has some ambigous arguments.
:ident: : :func→: {c} {c} (identityNat F , 𝟙 {o = proj₂ c}) 𝟙 𝔻
:ident: : :func→: {c} {c} (identityNat F , 𝟙 {A = proj₂ c}) 𝟙 𝔻
:ident: = begin
:func→: {c} {c} (𝟙 (Product.obj (:obj: ×p )) {c}) ≡⟨⟩
:func→: {c} {c} (identityNat F , 𝟙 ) ≡⟨⟩
𝔻 [ identityTrans F C F .func→ (𝟙 )] ≡⟨⟩
𝔻 [ 𝟙 𝔻 F .func→ (𝟙 )] ≡⟨ proj₂ 𝔻.ident
F .func→ (𝟙 ) ≡⟨ F.ident
𝔻 [ identityTrans F C func→ F (𝟙 )] ≡⟨⟩
𝔻 [ 𝟙 𝔻 func→ F (𝟙 )] ≡⟨ proj₂ 𝔻.isIdentity
func→ F (𝟙 ) ≡⟨ F.isIdentity
𝟙 𝔻
where
open module 𝔻 = IsCategory (𝔻 .isCategory)
open module F = IsFunctor (F .isFunctor)
open module 𝔻 = Category 𝔻
open module F = Functor F
module _ {F×A G×B H×C : Functor 𝔻 × Object } where
F = F×A .proj₁
@ -330,48 +279,51 @@ module _ ( : Level) where
ηθ = proj₁ ηθNT
ηθNat = proj₂ ηθNT
:distrib: :
𝔻 [ 𝔻 [ η C θ C ] F .func→ ( [ g f ] ) ]
𝔻 [ 𝔻 [ η C G .func→ g ] 𝔻 [ θ B F .func→ f ] ]
:distrib: = begin
𝔻 [ (ηθ C) F .func→ ( [ g f ]) ]
:isDistributive: :
𝔻 [ 𝔻 [ η C θ C ] func→ F ( [ g f ] ) ]
𝔻 [ 𝔻 [ η C func→ G g ] 𝔻 [ θ B func→ F f ] ]
:isDistributive: = begin
𝔻 [ (ηθ C) func→ F ( [ g f ]) ]
≡⟨ ηθNat ( [ g f ])
𝔻 [ H .func→ ( [ g f ]) (ηθ A) ]
≡⟨ cong (λ φ 𝔻 [ φ ηθ A ]) (H.distrib)
𝔻 [ 𝔻 [ H .func→ g H .func→ f ] (ηθ A) ]
≡⟨ sym assoc
𝔻 [ H .func→ g 𝔻 [ H .func→ f ηθ A ] ]
≡⟨ cong (λ φ 𝔻 [ H .func→ g φ ]) assoc
𝔻 [ H .func→ g 𝔻 [ 𝔻 [ H .func→ f η A ] θ A ] ]
≡⟨ cong (λ φ 𝔻 [ H .func→ g φ ]) (cong (λ φ 𝔻 [ φ θ A ]) (sym (ηNat f)))
𝔻 [ H .func→ g 𝔻 [ 𝔻 [ η B G .func→ f ] θ A ] ]
≡⟨ cong (λ φ 𝔻 [ H .func→ g φ ]) (sym assoc)
𝔻 [ H .func→ g 𝔻 [ η B 𝔻 [ G .func→ f θ A ] ] ] ≡⟨ assoc
𝔻 [ 𝔻 [ H .func→ g η B ] 𝔻 [ G .func→ f θ A ] ]
≡⟨ cong (λ φ 𝔻 [ φ 𝔻 [ G .func→ f θ A ] ]) (sym (ηNat g))
𝔻 [ 𝔻 [ η C G .func→ g ] 𝔻 [ G .func→ f θ A ] ]
≡⟨ cong (λ φ 𝔻 [ 𝔻 [ η C G .func→ g ] φ ]) (sym (θNat f))
𝔻 [ 𝔻 [ η C G .func→ g ] 𝔻 [ θ B F .func→ f ] ]
𝔻 [ func→ H ( [ g f ]) (ηθ A) ]
≡⟨ cong (λ φ 𝔻 [ φ ηθ A ]) (H.isDistributive)
𝔻 [ 𝔻 [ func→ H g func→ H f ] (ηθ A) ]
≡⟨ sym isAssociative
𝔻 [ func→ H g 𝔻 [ func→ H f ηθ A ] ]
≡⟨ cong (λ φ 𝔻 [ func→ H g φ ]) isAssociative
𝔻 [ func→ H g 𝔻 [ 𝔻 [ func→ H f η A ] θ A ] ]
≡⟨ cong (λ φ 𝔻 [ func→ H g φ ]) (cong (λ φ 𝔻 [ φ θ A ]) (sym (ηNat f)))
𝔻 [ func→ H g 𝔻 [ 𝔻 [ η B func→ G f ] θ A ] ]
≡⟨ cong (λ φ 𝔻 [ func→ H g φ ]) (sym isAssociative)
𝔻 [ func→ H g 𝔻 [ η B 𝔻 [ func→ G f θ A ] ] ]
≡⟨ isAssociative
𝔻 [ 𝔻 [ func→ H g η B ] 𝔻 [ func→ G f θ A ] ]
≡⟨ cong (λ φ 𝔻 [ φ 𝔻 [ func→ G f θ A ] ]) (sym (ηNat g))
𝔻 [ 𝔻 [ η C func→ G g ] 𝔻 [ func→ G f θ A ] ]
≡⟨ cong (λ φ 𝔻 [ 𝔻 [ η C func→ G g ] φ ]) (sym (θNat f))
𝔻 [ 𝔻 [ η C func→ G g ] 𝔻 [ θ B func→ F f ] ]
where
open IsCategory (𝔻 .isCategory)
open module H = IsFunctor (H .isFunctor)
open Category 𝔻
module H = Functor H
:eval: : Functor ((:obj: ×p ) .Product.obj) 𝔻
:eval: = record
{ func* = :func*:
; func→ = λ {dom} {cod} :func→: {dom} {cod}
{ raw = record
{ func* = :func*:
; func→ = λ {dom} {cod} :func→: {dom} {cod}
}
; isFunctor = record
{ ident = λ {o} :ident: {o}
; distrib = λ {f u n k y} :distrib: {f} {u} {n} {k} {y}
{ isIdentity = λ {o} :ident: {o}
; isDistributive = λ {f u n k y} :isDistributive: {f} {u} {n} {k} {y}
}
}
module _ (𝔸 : Category ) (F : Functor ((𝔸 ×p ) .Product.obj) 𝔻) where
open HasProducts (hasProducts {} {}) renaming (_|×|_ to parallelProduct)
open HasProducts (hasProducts {} {} unprovable) renaming (_|×|_ to parallelProduct)
postulate
transpose : Functor 𝔸 :obj:
eq : Cat [ :eval: (parallelProduct transpose (𝟙 Cat {o = })) ] F
eq : Cat [ :eval: (parallelProduct transpose (𝟙 Cat {A = })) ] F
-- eq : Cat [ :eval: ∘ (HasProducts._|×|_ hasProducts transpose (𝟙 Cat {o = })) ] ≡ F
-- eq' : (Cat [ :eval: ∘
-- (record { product = product } HasProducts.|×| transpose)
@ -384,10 +336,11 @@ module _ ( : Level) where
-- :eval: (parallelProduct F~ (𝟙 Cat {o = }))] F) catTranspose =
-- transpose , eq
:isExponential: : IsExponential Cat 𝔻 :obj: :eval:
:isExponential: = {!catTranspose!}
where
open HasProducts (hasProducts {} {}) using (_|×|_)
postulate :isExponential: : IsExponential Cat 𝔻 :obj: :eval:
-- :isExponential: : IsExponential Cat 𝔻 :obj: :eval:
-- :isExponential: = {!catTranspose!}
-- where
-- open HasProducts (hasProducts {} {} unprovable) using (_|×|_)
-- :isExponential: = λ 𝔸 F transpose 𝔸 F , eq' 𝔸 F
-- :exponent: : Exponential (Cat ) A B
@ -398,5 +351,5 @@ module _ ( : Level) where
; isExponential = :isExponential:
}
hasExponentials : HasExponentials (Cat )
hasExponentials : HasExponentials Cat
hasExponentials = record { exponent = :exponent: }

View File

@ -25,12 +25,12 @@ module _ (a b : Level) where
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
assoc : (D h C g f ) D D h g f
assoc = Σ≡ refl refl
isAssociative : (D h C g f ) D D h g f
isAssociative = Σ≡ refl refl
module _ {A B : Obj'} {f : Arr A B} where
ident : B f one f × B one {B} f f
ident = (Σ≡ refl refl) , Σ≡ refl refl
isIdentity : B f one f × B one {B} f f
isIdentity = (Σ≡ refl refl) , Σ≡ refl refl
RawFam : RawCategory (lsuc (a b)) (a b)
@ -44,9 +44,9 @@ module _ (a b : Level) where
instance
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}
; arrowIsSet = {!!}
{ isAssociative = λ {A} {B} {C} {D} {f} {g} {h} isAssociative {D = D} {f} {g} {h}
; isIdentity = λ {A} {B} {f} isIdentity {A} {B} {f = f}
; arrowsAreSets = {!!}
; univalent = {!!}
}

View File

@ -9,14 +9,6 @@ open import Cat.Category
open IsCategory
-- data Path { : Level} {A : Set } : (a b : A) → Set where
-- emptyPath : {a : A} → Path a a
-- concatenate : {a b c : A} → Path a b → Path b c → Path a b
-- import Data.List
-- P : (a b : Object ) → Set (')
-- P = {!Data.List.List ?!}
-- Generalized paths:
data Path { ' : Level} {A : Set } (R : A A Set ') : (a b : A) Set ( ') where
empty : {a : A} Path R a a
cons : {a b c : A} R b c Path R a b Path R a c
@ -34,16 +26,16 @@ module _ { ' : Level} ( : Category ') where
open Category
private
p-assoc : {A B C D : Object} {r : Path Arrow A B} {q : Path Arrow B C} {p : Path Arrow C D}
p-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-assoc {r = r} {q} {empty} = refl
p-assoc {A} {B} {C} {D} {r = r} {q} {cons x p} = begin
p-isAssociative {r = r} {q} {empty} = refl
p-isAssociative {A} {B} {C} {D} {r = r} {q} {cons x p} = begin
cons x p ++ (q ++ r) ≡⟨ cong (cons x) lem
cons x ((p ++ q) ++ r) ≡⟨⟩
(cons x p ++ q) ++ r
where
lem : p ++ (q ++ r) ((p ++ q) ++ r)
lem = p-assoc {r = r} {q} {p}
lem = p-isAssociative {r = r} {q} {p}
ident-r : {A} {B} {p : Path Arrow A B} concatenate p empty p
ident-r {p = empty} = refl
@ -65,8 +57,8 @@ module _ { ' : Level} ( : Category ') where
}
RawIsCategoryFree : IsCategory RawFree
RawIsCategoryFree = record
{ assoc = λ { {f = f} {g} {h} p-assoc {r = f} {g} {h}}
; ident = ident-r , ident-l
; arrowIsSet = {!!}
{ isAssociative = λ { {f = f} {g} {h} p-isAssociative {r = f} {g} {h}}
; isIdentity = ident-r , ident-l
; arrowsAreSets = {!!}
; univalent = {!!}
}

View File

@ -38,9 +38,6 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
(f : [ A , B ])
𝔻 [ θ B F.func→ f ] 𝔻 [ G.func→ f θ A ]
-- naturalIsProp : ∀ θ → isProp (Natural θ)
-- naturalIsProp θ x y = {!funExt!}
NaturalTransformation : Set (c c' d')
NaturalTransformation = Σ Transformation Natural
@ -63,8 +60,8 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
identityNatural : (F : Functor 𝔻) Natural F F (identityTrans F)
identityNatural F {A = A} {B = B} f = begin
𝔻 [ identityTrans F B F→ f ] ≡⟨⟩
𝔻 [ 𝟙 𝔻 F→ f ] ≡⟨ proj₂ 𝔻.ident
F→ f ≡⟨ sym (proj₁ 𝔻.ident)
𝔻 [ 𝟙 𝔻 F→ f ] ≡⟨ proj₂ 𝔻.isIdentity
F→ f ≡⟨ sym (proj₁ 𝔻.isIdentity)
𝔻 [ F→ f 𝟙 𝔻 ] ≡⟨⟩
𝔻 [ F→ f identityTrans F A ]
where
@ -87,11 +84,11 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
proj₁ ((θ , _) :⊕: (η , _)) = θ ∘nt η
proj₂ ((θ , θNat) :⊕: (η , ηNat)) {A} {B} f = begin
𝔻 [ (θ ∘nt η) B F.func→ f ] ≡⟨⟩
𝔻 [ 𝔻 [ θ B η B ] F.func→ f ] ≡⟨ sym assoc
𝔻 [ 𝔻 [ θ B η B ] F.func→ f ] ≡⟨ sym isAssociative
𝔻 [ θ B 𝔻 [ η B F.func→ f ] ] ≡⟨ cong (λ φ 𝔻 [ θ B φ ]) (ηNat f)
𝔻 [ θ B 𝔻 [ G.func→ f η A ] ] ≡⟨ assoc
𝔻 [ θ B 𝔻 [ G.func→ f η A ] ] ≡⟨ isAssociative
𝔻 [ 𝔻 [ θ B G.func→ f ] η A ] ≡⟨ cong (λ φ 𝔻 [ φ η A ]) (θNat f)
𝔻 [ 𝔻 [ H.func→ f θ A ] η A ] ≡⟨ sym assoc
𝔻 [ 𝔻 [ H.func→ f θ A ] η A ] ≡⟨ sym isAssociative
𝔻 [ H.func→ f 𝔻 [ θ A η A ] ] ≡⟨⟩
𝔻 [ H.func→ f (θ ∘nt η) A ]
where
@ -100,59 +97,56 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
NatComp = _:⊕:_
private
module _ {F G : Functor 𝔻} where
module 𝔻 = Category 𝔻
module 𝔻 = Category 𝔻
transformationIsSet : isSet (Transformation F G)
transformationIsSet _ _ p q i j C = 𝔻.arrowIsSet _ _ (λ l p l C) (λ l q l C) i j
IsSet' : { : Level} (A : Set ) Set
IsSet' A = {x y : A} (p q : (λ _ A) [ x y ]) p q
module _ {F G : Functor 𝔻} where
transformationIsSet : isSet (Transformation F G)
transformationIsSet _ _ p q i j C = 𝔻.arrowsAreSets _ _ (λ l p l C) (λ l q l C) i j
naturalIsProp : (θ : Transformation F G) isProp (Natural F G θ)
naturalIsProp θ θNat θNat' = lem
where
lem : (λ _ Natural F G θ) [ (λ f θNat f) (λ f θNat' f) ]
lem = λ i f 𝔻.arrowIsSet _ _ (θNat f) (θNat' f) i
naturalIsProp : (θ : Transformation F G) isProp (Natural F G θ)
naturalIsProp θ θNat θNat' = lem
where
lem : (λ _ Natural F G θ) [ (λ f θNat f) (λ f θNat' f) ]
lem = λ i f 𝔻.arrowsAreSets _ _ (θNat f) (θNat' f) i
naturalTransformationIsSets : isSet (NaturalTransformation F G)
naturalTransformationIsSets = sigPresSet transformationIsSet
λ θ ntypeCommulative
(s≤s {n = Nat.suc Nat.zero} z≤n)
(naturalIsProp θ)
naturalTransformationIsSets : isSet (NaturalTransformation F G)
naturalTransformationIsSets = sigPresSet transformationIsSet
λ θ ntypeCommulative
(s≤s {n = Nat.suc Nat.zero} z≤n)
(naturalIsProp θ)
module _ {A B C D : Functor 𝔻} {θ' : NaturalTransformation A B}
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
private
θ = proj₁ θ'
η = proj₁ η'
ζ = proj₁ ζ'
θNat = proj₂ θ'
ηNat = proj₂ η'
ζNat = proj₂ ζ'
L : NaturalTransformation A D
L = (_:⊕:_ {A} {C} {D} ζ' (_:⊕:_ {A} {B} {C} η' θ'))
R : NaturalTransformation A D
R = (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} ζ' η') θ')
_g⊕f_ = _:⊕:_ {A} {B} {C}
_h⊕g_ = _:⊕:_ {B} {C} {D}
:assoc: : L R
:assoc: = lemSig (naturalIsProp {F = A} {D})
L R (funExt (λ x assoc))
where
open Category 𝔻
module _ {A B C D : Functor 𝔻} {θ' : NaturalTransformation A B}
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
private
θ = proj₁ θ'
η = proj₁ η'
ζ = proj₁ ζ'
θNat = proj₂ θ'
ηNat = proj₂ η'
ζNat = proj₂ ζ'
L : NaturalTransformation A D
L = (_:⊕:_ {A} {C} {D} ζ' (_:⊕:_ {A} {B} {C} η' θ'))
R : NaturalTransformation A D
R = (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} ζ' η') θ')
_g⊕f_ = _:⊕:_ {A} {B} {C}
_h⊕g_ = _:⊕:_ {B} {C} {D}
:isAssociative: : L R
:isAssociative: = lemSig (naturalIsProp {F = A} {D})
L R (funExt (λ x isAssociative))
where
open Category 𝔻
private
module _ {A B : Functor 𝔻} {f : NaturalTransformation A B} where
private
allNatural = naturalIsProp {F = A} {B}
f' = proj₁ f
module 𝔻Data = Category 𝔻
eq-r : C (𝔻 [ f' C identityTrans A C ]) f' C
eq-r C = begin
𝔻 [ f' C identityTrans A C ] ≡⟨⟩
𝔻 [ f' C 𝔻Data.𝟙 ] ≡⟨ proj₁ (𝔻.ident {A} {B})
f' C
eq-l : C (𝔻 [ identityTrans B C f' C ]) f' C
eq-l C = proj₂ (𝔻.ident {A} {B})
allNatural = naturalIsProp {F = A} {B}
f' = proj₁ f
eq-r : C (𝔻 [ f' C identityTrans A C ]) f' C
eq-r C = begin
𝔻 [ f' C identityTrans A C ] ≡⟨⟩
𝔻 [ f' C 𝔻.𝟙 ] ≡⟨ proj₁ 𝔻.isIdentity
f' C
eq-l : C (𝔻 [ identityTrans B C f' C ]) f' C
eq-l C = proj₂ 𝔻.isIdentity
ident-r : (_:⊕:_ {A} {A} {B} f (identityNat A)) f
ident-r = lemSig allNatural _ _ (funExt eq-r)
ident-l : (_:⊕:_ {A} {B} {B} (identityNat B) f) f
@ -174,9 +168,9 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
instance
:isCategory: : IsCategory RawFun
:isCategory: = record
{ assoc = λ {A B C D} :assoc: {A} {B} {C} {D}
; ident = λ {A B} :ident: {A} {B}
; arrowIsSet = λ {F} {G} naturalTransformationIsSets {F} {G}
{ isAssociative = λ {A B C D} :isAssociative: {A} {B} {C} {D}
; isIdentity = λ {A B} :ident: {A} {B}
; arrowsAreSets = λ {F} {G} naturalTransformationIsSets {F} {G}
; univalent = {!!}
}

View File

@ -149,10 +149,10 @@ 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))
equi = fwd Cubical.FromStdLib., isequiv
-- assocc : Q + (R + S) ≡ (Q + R) + S
is-assoc : (Σ[ c C ] (Σ[ b B ] (a , b) S × (b , c) R) × (c , d) Q)
-- isAssociativec : Q + (R + S) ≡ (Q + R) + S
is-isAssociative : (Σ[ c C ] (Σ[ b B ] (a , b) S × (b , c) R) × (c , d) Q)
(Σ[ b B ] (a , b) S × (Σ[ c C ] (b , c) R × (c , d) Q))
is-assoc = equivToPath equi
is-isAssociative = equivToPath equi
RawRel : RawCategory (lsuc lzero) (lsuc lzero)
RawRel = record
@ -164,8 +164,8 @@ RawRel = record
RawIsCategoryRel : IsCategory RawRel
RawIsCategoryRel = record
{ assoc = funExt is-assoc
; ident = funExt ident-l , funExt ident-r
; arrowIsSet = {!!}
{ isAssociative = funExt is-isAssociative
; isIdentity = funExt ident-l , funExt ident-r
; arrowsAreSets = {!!}
; univalent = {!!}
}

View File

@ -25,10 +25,10 @@ module _ ( : Level) where
_∘_ SetsRaw = Function._∘_
SetsIsCategory : IsCategory SetsRaw
assoc SetsIsCategory = refl
proj₁ (ident SetsIsCategory) = funExt λ _ refl
proj₂ (ident SetsIsCategory) = funExt λ _ refl
arrowIsSet SetsIsCategory {B = (_ , s)} = setPi λ _ s
isAssociative SetsIsCategory = refl
proj₁ (isIdentity SetsIsCategory) = funExt λ _ refl
proj₂ (isIdentity SetsIsCategory) = funExt λ _ refl
arrowsAreSets SetsIsCategory {B = (_ , s)} = setPi λ _ s
univalent SetsIsCategory = {!!}
𝓢𝓮𝓽 Sets : Category (lsuc )
@ -94,12 +94,12 @@ module _ {a b : Level} where
representable : { : Category a b} Category.Object Representable
representable { = } A = record
{ raw = record
{ func* = λ B [ A , B ] , arrowIsSet
{ func* = λ B [ A , B ] , arrowsAreSets
; func→ = [_∘_]
}
; isFunctor = record
{ ident = funExt λ _ proj₂ ident
; distrib = funExt λ x sym assoc
{ isIdentity = funExt λ _ proj₂ isIdentity
; isDistributive = funExt λ x sym isAssociative
}
}
where
@ -109,12 +109,12 @@ module _ {a b : Level} where
presheaf : { : Category a b} Category.Object (Opposite ) Presheaf
presheaf { = } B = record
{ raw = record
{ func* = λ A [ A , B ] , arrowIsSet
{ func* = λ A [ A , B ] , arrowsAreSets
; func→ = λ f g [ g f ]
}
; isFunctor = record
{ ident = funExt λ x proj₁ ident
; distrib = funExt λ x assoc
{ isIdentity = funExt λ x proj₁ isIdentity
; isDistributive = funExt λ x isAssociative
}
}
where

View File

@ -49,6 +49,9 @@ record RawCategory (a b : Level) : Set (lsuc (a ⊔ b)) where
IsIdentity id = {A B : Object} {f : Arrow A B}
f id f × id f f
ArrowsAreSets : Set (a b)
ArrowsAreSets = {A B : Object} isSet (Arrow A B)
IsInverseOf : {A B} (Arrow A B) (Arrow B A) Set b
IsInverseOf = λ f g g f 𝟙 × f g 𝟙
@ -80,9 +83,9 @@ record RawCategory (a b : Level) : Set (lsuc (a ⊔ b)) where
-- Univalence is indexed by a raw category as well as an identity proof.
module Univalence {a b : Level} ( : RawCategory a b) where
open RawCategory
module _ (ident : IsIdentity 𝟙) where
module _ (isIdentity : IsIdentity 𝟙) where
idIso : (A : Object) A A
idIso A = 𝟙 , (𝟙 , ident)
idIso A = 𝟙 , (𝟙 , isIdentity)
-- Lemma 9.1.4 in [HoTT]
id-to-iso : (A B : Object) A B A B
@ -98,10 +101,10 @@ record IsCategory {a b : Level} ( : RawCategory a b) : Set (lsuc
open RawCategory
open Univalence public
field
assoc : IsAssociative
ident : IsIdentity 𝟙
arrowIsSet : {A B : Object} isSet (Arrow A B)
univalent : Univalent ident
isAssociative : IsAssociative
isIdentity : IsIdentity 𝟙
arrowsAreSets : ArrowsAreSets
univalent : Univalent isIdentity
-- `IsCategory` is a mere proposition.
module _ {a b : Level} {C : RawCategory a b} where
@ -112,12 +115,12 @@ module _ {a b : Level} {C : RawCategory a b} where
open import Cubical.NType.Properties
propIsAssociative : isProp IsAssociative
propIsAssociative x y i = arrowIsSet _ _ x y i
propIsAssociative x y i = arrowsAreSets _ _ 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
= arrowsAreSets _ _ (fst a) (fst b) i
, arrowsAreSets _ _ (snd a) (snd b) i
propArrowIsSet : isProp ( {A B} isSet (Arrow A B))
propArrowIsSet a b i = isSetIsProp a b i
@ -126,9 +129,9 @@ module _ {a b : Level} {C : RawCategory a b} where
propIsInverseOf x y = λ i
let
h : fst x fst y
h = arrowIsSet _ _ (fst x) (fst y)
h = arrowsAreSets _ _ (fst x) (fst y)
hh : snd x snd y
hh = arrowIsSet _ _ (snd x) (snd y)
hh = arrowsAreSets _ _ (snd x) (snd y)
in h i , hh i
module _ {A B : Object} {f : Arrow A B} where
@ -139,14 +142,14 @@ module _ {a b : Level} {C : RawCategory a b} where
open Cubical.NType.Properties
geq : g g'
geq = begin
g ≡⟨ sym (fst ident)
g ≡⟨ sym (fst isIdentity)
g 𝟙 ≡⟨ cong (λ φ g φ) (sym ε')
g (f g') ≡⟨ assoc
g (f g') ≡⟨ isAssociative
(g f) g' ≡⟨ cong (λ φ φ g') η
𝟙 g' ≡⟨ snd ident
𝟙 g' ≡⟨ snd isIdentity
g'
propUnivalent : isProp (Univalent ident)
propUnivalent : isProp (Univalent isIdentity)
propUnivalent a b i = propPi (λ iso propHasLevel ⟨-2⟩) a b i
private
@ -159,23 +162,28 @@ module _ {a b : Level} {C : RawCategory a b} where
-- projections of `IsCategory` - I've arbitrarily chosed to use this
-- result from `x : IsCategory C`. I don't know which (if any) possibly
-- adverse effects this may have.
ident : (λ _ IsIdentity 𝟙) [ X.ident Y.ident ]
ident = propIsIdentity x X.ident Y.ident
isIdentity : (λ _ IsIdentity 𝟙) [ X.isIdentity Y.isIdentity ]
isIdentity = propIsIdentity x X.isIdentity Y.isIdentity
done : x y
U : {a : IsIdentity 𝟙} (λ _ IsIdentity 𝟙) [ X.ident a ] (b : Univalent a) Set _
U eqwal bbb = (λ i Univalent (eqwal i)) [ X.univalent bbb ]
U : {a : IsIdentity 𝟙}
(λ _ IsIdentity 𝟙) [ X.isIdentity a ]
(b : Univalent a)
Set _
U eqwal bbb =
(λ i Univalent (eqwal i))
[ X.univalent bbb ]
P : (y : IsIdentity 𝟙)
(λ _ IsIdentity 𝟙) [ X.ident y ] Set _
(λ _ IsIdentity 𝟙) [ X.isIdentity y ] Set _
P y eq = (b' : Univalent y) U eq b'
helper : (b' : Univalent X.ident)
(λ _ Univalent X.ident) [ X.univalent b' ]
helper : (b' : Univalent X.isIdentity)
(λ _ Univalent X.isIdentity) [ X.univalent b' ]
helper univ = propUnivalent x X.univalent univ
foo = pathJ P helper Y.ident ident
eqUni : U ident Y.univalent
foo = pathJ P helper Y.isIdentity isIdentity
eqUni : U isIdentity Y.univalent
eqUni = foo Y.univalent
IC.assoc (done i) = propIsAssociative x X.assoc Y.assoc i
IC.ident (done i) = ident i
IC.arrowIsSet (done i) = propArrowIsSet x X.arrowIsSet Y.arrowIsSet i
IC.isAssociative (done i) = propIsAssociative x X.isAssociative Y.isAssociative i
IC.isIdentity (done i) = isIdentity i
IC.arrowsAreSets (done i) = propArrowIsSet x X.arrowsAreSets Y.arrowsAreSets i
IC.univalent (done i) = eqUni i
propIsCategory : isProp (IsCategory C)
@ -208,9 +216,9 @@ module _ {a b : Level} ( : Category a b) where
RawCategory._∘_ OpRaw = Function.flip _∘_
OpIsCategory : IsCategory OpRaw
IsCategory.assoc OpIsCategory = sym assoc
IsCategory.ident OpIsCategory = swap ident
IsCategory.arrowIsSet OpIsCategory = arrowIsSet
IsCategory.isAssociative OpIsCategory = sym isAssociative
IsCategory.isIdentity OpIsCategory = swap isIdentity
IsCategory.arrowsAreSets OpIsCategory = arrowsAreSets
IsCategory.univalent OpIsCategory = {!!}
Opposite : Category a b
@ -234,9 +242,9 @@ module _ {a b : Level} { : Category a b} where
open IsCategory
module IsCat = IsCategory ( .isCategory)
rawIsCat : (i : I) IsCategory (rawOp i)
assoc (rawIsCat i) = IsCat.assoc
ident (rawIsCat i) = IsCat.ident
arrowIsSet (rawIsCat i) = IsCat.arrowIsSet
isAssociative (rawIsCat i) = IsCat.isAssociative
isIdentity (rawIsCat i) = IsCat.isIdentity
arrowsAreSets (rawIsCat i) = IsCat.arrowsAreSets
univalent (rawIsCat i) = IsCat.univalent
Opposite-is-involution : Opposite (Opposite )

View File

@ -35,5 +35,6 @@ module _ { '} ( : Category ') {{hasProducts : HasProducts }}
transpose A f = proj₁ (isExponential A f)
record HasExponentials { ' : Level} ( : Category ') {{_ : HasProducts }} : Set ( ') where
open Exponential public
field
exponent : (A B : Object ) Exponential A B

View File

@ -7,7 +7,7 @@ open import Function
open import Cat.Category
open Category hiding (_∘_ ; raw)
open Category hiding (_∘_ ; raw ; IsIdentity)
module _ {c c' d d'}
( : Category c c')
@ -23,42 +23,40 @@ module _ {c c' d d'}
func* : Object Object 𝔻
func→ : {A B} [ A , B ] 𝔻 [ func* A , func* B ]
IsIdentity : Set _
IsIdentity = {A : Object } func→ (𝟙 {A}) 𝟙 𝔻 {func* A}
IsDistributive : Set _
IsDistributive = {A B C : Object } {f : [ A , B ]} {g : [ B , C ]}
func→ ( [ g f ]) 𝔻 [ func→ g func→ f ]
record IsFunctor (F : RawFunctor) : 𝓤 where
open RawFunctor F
open RawFunctor F public
field
ident : {c : Object } func→ (𝟙 {c}) 𝟙 𝔻 {func* c}
distrib : {A B C : Object } {f : [ A , B ]} {g : [ B , C ]}
func→ ( [ g f ]) 𝔻 [ func→ g func→ f ]
isIdentity : IsIdentity
isDistributive : IsDistributive
record Functor : Set (c c' d d') where
field
raw : RawFunctor
{{isFunctor}} : IsFunctor raw
private
module R = RawFunctor raw
open IsFunctor isFunctor public
func* : Object Object 𝔻
func* = R.func*
func→ : {A B} [ A , B ] 𝔻 [ func* A , func* B ]
func→ = R.func→
open IsFunctor
open Functor
module _
{a b : Level}
{ 𝔻 : Category a b}
{F : RawFunctor 𝔻}
(F : RawFunctor 𝔻)
where
private
module 𝔻 = IsCategory (isCategory 𝔻)
propIsFunctor : isProp (IsFunctor _ _ F)
propIsFunctor isF0 isF1 i = record
{ ident = 𝔻.arrowIsSet _ _ isF0.ident isF1.ident i
; distrib = 𝔻.arrowIsSet _ _ isF0.distrib isF1.distrib i
{ isIdentity = 𝔻.arrowsAreSets _ _ isF0.isIdentity isF1.isIdentity i
; isDistributive = 𝔻.arrowsAreSets _ _ isF0.isDistributive isF1.isDistributive i
}
where
module isF0 = IsFunctor isF0
@ -77,7 +75,7 @@ module _
IsFunctorIsProp' : IsProp' λ i IsFunctor _ _ (F i)
IsFunctorIsProp' isF0 isF1 = lemPropF {B = IsFunctor 𝔻}
(\ F propIsFunctor {F = F}) (\ i F i)
(\ F propIsFunctor F) (\ i F i)
where
open import Cubical.NType.Properties using (lemPropF)
@ -108,8 +106,8 @@ module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : F
dist : (F→ G→) (A [ α1 α0 ]) C [ (F→ G→) α1 (F→ G→) α0 ]
dist = begin
(F→ G→) (A [ α1 α0 ]) ≡⟨ refl
F→ (G→ (A [ α1 α0 ])) ≡⟨ cong F→ (G .isFunctor .distrib)
F→ (B [ G→ α1 G→ α0 ]) ≡⟨ F .isFunctor .distrib
F→ (G→ (A [ α1 α0 ])) ≡⟨ cong F→ (isDistributive G)
F→ (B [ G→ α1 G→ α0 ]) ≡⟨ isDistributive F
C [ (F→ G→) α1 (F→ G→) α0 ]
_∘fr_ : RawFunctor A C
@ -118,12 +116,12 @@ module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : F
instance
isFunctor' : IsFunctor A C _∘fr_
isFunctor' = record
{ ident = begin
{ isIdentity = begin
(F→ G→) (𝟙 A) ≡⟨ refl
F→ (G→ (𝟙 A)) ≡⟨ cong F→ (G .isFunctor .ident)
F→ (𝟙 B) ≡⟨ F .isFunctor .ident
F→ (G→ (𝟙 A)) ≡⟨ cong F→ (isIdentity G)
F→ (𝟙 B) ≡⟨ isIdentity F
𝟙 C
; distrib = dist
; isDistributive = dist
}
_∘f_ : Functor A C
@ -137,7 +135,7 @@ identity = record
; func→ = λ x x
}
; isFunctor = record
{ ident = refl
; distrib = refl
{ isIdentity = refl
; isDistributive = refl
}
}

View File

@ -17,106 +17,77 @@ module _ { ' : Level} { : Category '} { A B : Category.Object
iso-is-epi : Isomorphism f Epimorphism {X = X} f
iso-is-epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
g₀ ≡⟨ sym (proj₁ ident)
g₀ ≡⟨ sym (proj₁ isIdentity)
g₀ 𝟙 ≡⟨ cong (_∘_ g₀) (sym right-inv)
g₀ (f f-) ≡⟨ assoc
g₀ (f f-) ≡⟨ isAssociative
(g₀ f) f- ≡⟨ cong (λ φ φ f-) eq
(g₁ f) f- ≡⟨ sym assoc
(g₁ f) f- ≡⟨ sym isAssociative
g₁ (f f-) ≡⟨ cong (_∘_ g₁) right-inv
g₁ 𝟙 ≡⟨ proj₁ ident
g₁ 𝟙 ≡⟨ proj₁ isIdentity
g₁
iso-is-mono : Isomorphism f Monomorphism {X = X} f
iso-is-mono (f- , (left-inv , right-inv)) g₀ g₁ eq =
begin
g₀ ≡⟨ sym (proj₂ ident)
g₀ ≡⟨ sym (proj₂ isIdentity)
𝟙 g₀ ≡⟨ cong (λ φ φ g₀) (sym left-inv)
(f- f) g₀ ≡⟨ sym assoc
(f- f) g₀ ≡⟨ sym isAssociative
f- (f g₀) ≡⟨ cong (_∘_ f-) eq
f- (f g₁) ≡⟨ assoc
f- (f g₁) ≡⟨ isAssociative
(f- f) g₁ ≡⟨ cong (λ φ φ g₁) left-inv
𝟙 g₁ ≡⟨ proj₂ ident
𝟙 g₁ ≡⟨ proj₂ isIdentity
g₁
iso-is-epi-mono : Isomorphism f Epimorphism {X = X} f × Monomorphism {X = X} f
iso-is-epi-mono iso = iso-is-epi iso , iso-is-mono iso
{-
epi-mono-is-not-iso : { '} ¬ (( : Category {} {'}) {A B X : Object } (f : Arrow A B ) Epimorphism { = } {X = X} f Monomorphism { = } {X = X} f Isomorphism { = } f)
epi-mono-is-not-iso f =
let k = f {!!} {!!} {!!} {!!}
in {!!}
-}
-- TODO: We want to avoid defining the yoneda embedding going through the
-- category of categories (since it doesn't exist).
open import Cat.Categories.Cat using (RawCat)
open import Cat.Category
open Category
open Functor
module _ { : Level} { : Category } (unprovable : IsCategory (RawCat )) where
open import Cat.Categories.Fun
open import Cat.Categories.Sets
module Cat = Cat.Categories.Cat
open import Cat.Category.Exponential
open Functor
𝓢 = Sets
private
Cat : Category _ _
Cat = record { raw = RawCat ; isCategory = unprovable}
prshf = presheaf { = }
module = Category
-- module _ { : Level} { : Category }
-- {isSObj : isSet ( .Object)}
-- {isz2 : ∀ {} → {A B : Set } → isSet (Sets [ A , B ])} where
-- -- open import Cat.Categories.Cat using (Cat)
-- open import Cat.Categories.Fun
-- open import Cat.Categories.Sets
-- -- module Cat = Cat.Categories.Cat
-- open import Cat.Category.Exponential
-- private
-- Cat = Cat
-- prshf = presheaf { = }
-- module = IsCategory ( .isCategory)
_⇑_ : (A B : Category.Object Cat) Category.Object Cat
A B = (exponent A B) .obj
where
open HasExponentials (Cat.hasExponentials unprovable)
-- -- Exp : Set (lsuc (lsuc ))
-- -- Exp = Exponential (Cat (lsuc ) )
-- -- Sets (Opposite )
module _ {A B : .Object} (f : [ A , B ]) where
:func→: : NaturalTransformation (prshf A) (prshf B)
:func→: = (λ C x [ f x ]) , λ f₁ funExt λ _ .isAssociative
-- _⇑_ : (A B : Cat .Object) → Cat .Object
-- A ⇑ B = (exponent A B) .obj
-- where
-- open HasExponentials (Cat.hasExponentials )
module _ {c : Category.Object } where
eqTrans : (λ _ Transformation (prshf c) (prshf c))
[ (λ _ x [ .𝟙 x ]) identityTrans (prshf c) ]
eqTrans = funExt λ x funExt λ x .isIdentity .proj₂
-- module _ {A B : .Object} (f : .Arrow A B) where
-- :func→: : NaturalTransformation (prshf A) (prshf B)
-- :func→: = (λ C x [ f x ]) , λ f₁ funExt λ _ .assoc
open import Cubical.NType.Properties
open import Cat.Categories.Fun
:ident: : :func→: (.𝟙 {c}) Category.𝟙 Fun {A = prshf c}
:ident: = lemSig (naturalIsProp {F = prshf c} {prshf c}) _ _ eq
where
eq : (λ C x [ .𝟙 x ]) identityTrans (prshf c)
eq = funExt λ A funExt λ B proj₂ .isIdentity
-- module _ {c : .Object} where
-- eqTrans : (λ _ → Transformation (prshf c) (prshf c))
-- [ (λ _ x → [ .𝟙 ∘ x ]) ≡ identityTrans (prshf c) ]
-- eqTrans = funExt λ x → funExt λ x → .ident .proj₂
-- eqNat : (λ i → Natural (prshf c) (prshf c) (eqTrans i))
-- [(λ _ → funExt (λ _ → .assoc)) ≡ identityNatural (prshf c)]
-- eqNat = λ i {A} {B} f →
-- let
-- open IsCategory (Sets .isCategory)
-- lemm : (Sets [ eqTrans i B ∘ prshf c .func→ f ]) ≡
-- (Sets [ prshf c .func→ f ∘ eqTrans i A ])
-- lemm = {!!}
-- lem : (λ _ → Sets [ Functor.func* (prshf c) A , prshf c .func* B ])
-- [ Sets [ eqTrans i B ∘ prshf c .func→ f ]
-- ≡ Sets [ prshf c .func→ f ∘ eqTrans i A ] ]
-- lem
-- = isz2 _ _ lemm _ i
-- -- (Sets [ eqTrans i B ∘ prshf c .func→ f ])
-- -- (Sets [ prshf c .func→ f ∘ eqTrans i A ])
-- -- lemm
-- -- _ i
-- in
-- lem
-- -- eqNat = λ {A} {B} i [B,A] i' [A,c] →
-- -- let
-- -- k : [ {!!} , {!!} ]
-- -- k = [A,c]
-- -- in {! [ ? ∘ ? ]!}
-- :ident: : (:func→: ( .𝟙 {c})) (Fun .𝟙 {o = prshf c})
-- :ident: = Σ≡ eqTrans eqNat
-- yoneda : Functor (Fun { = Opposite } {𝔻 = Sets {}})
-- yoneda = record
-- { func* = prshf
-- ; func→ = :func→:
-- ; isFunctor = record
-- { ident = :ident:
-- ; distrib = {!!}
-- }
-- }
yoneda : Functor (Fun { = Opposite } {𝔻 = 𝓢})
yoneda = record
{ raw = record
{ func* = prshf
; func→ = :func→:
}
; isFunctor = record
{ isIdentity = :ident:
; isDistributive = {!!}
}
}

View File

@ -20,28 +20,3 @@ module Equality where
Σ≡ : a b
proj₁ (Σ≡ i) = proj₁≡ i
proj₂ (Σ≡ i) = proj₂≡ i
-- Remark 2.7.1: This theorem:
--
-- (x , u) ≡ (x , v) → u ≡ v
--
-- does *not* hold! We can only conclude that there *exists* `p : x ≡ x`
-- such that
--
-- p* u ≡ v
-- thm : isSet A → (∀ {a} → isSet (B a)) → isSet (Σ A B)
-- thm sA sB (x , y) (x' , y') p q = res
-- where
-- x≡x'0 : x ≡ x'
-- x≡x'0 = λ i → proj₁ (p i)
-- x≡x'1 : x ≡ x'
-- x≡x'1 = λ i → proj₁ (q i)
-- someP : x ≡ x'
-- someP = {!!}
-- tricky : {!y!} ≡ y'
-- tricky = {!!}
-- -- res' : (λ _ → Σ A B) [ (x , y) ≡ (x' , y') ]
-- res' : ({!!} , {!!}) ≡ ({!!} , {!!})
-- res' = {!!}
-- res : p ≡ q
-- res i = {!res'!}