Merge branch 'dev'

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-05 11:51:13 +01:00
commit 36d10b0556
19 changed files with 786 additions and 441 deletions

View file

@ -7,3 +7,6 @@ depend:
cubical cubical
include: include:
src src
-- libraries:
-- libs/agda-stdlib
-- libs/cubical

@ -1 +1 @@
Subproject commit de23244a73d6dab55715fd5a107a5de805c55764 Subproject commit b5bfbc3c170b0bd0c9aaac1b4d4b3f9b06832bf6

@ -1 +1 @@
Subproject commit a83f5f4c63e5dfd8143ac03163868c63a56802de Subproject commit 1d6730c4999daa2b04e9dd39faa0791d0b5c3b48

46
proposal/Makefile Normal file
View file

@ -0,0 +1,46 @@
# Latex Makefile using latexmk
# Modified by Dogukan Cagatay <dcagatay@gmail.com>
# Originally from : http://tex.stackexchange.com/a/40759
#
# Change only the variable below to the name of the main tex file.
PROJNAME=proposal
# You want latexmk to *always* run, because make does not have all the info.
# Also, include non-file targets in .PHONY so they are run regardless of any
# file of the given name existing.
.PHONY: $(PROJNAME).pdf all clean
# The first rule in a Makefile is the one executed by default ("make"). It
# should always be the "all" rule, so that "make" and "make all" are identical.
all: $(PROJNAME).pdf
# CUSTOM BUILD RULES
# In case you didn't know, '$@' is a variable holding the name of the target,
# and '$<' is a variable holding the (first) dependency of a rule.
# "raw2tex" and "dat2tex" are just placeholders for whatever custom steps
# you might have.
%.tex: %.raw
./raw2tex $< > $@
%.tex: %.dat
./dat2tex $< > $@
# MAIN LATEXMK RULE
# -pdf tells latexmk to generate PDF directly (instead of DVI).
# -pdflatex="" tells latexmk to call a specific backend with specific options.
# -use-make tells latexmk to call make for generating missing files.
# -interactive=nonstopmode keeps the pdflatex backend from stopping at a
# missing file reference and interactively asking you for an alternative.
$(PROJNAME).pdf: $(PROJNAME).tex
latexmk -pdf -pdflatex="pdflatex -interactive=nonstopmode" -use-make $<
cleanall:
latexmk -C
clean:
latexmk -c

View file

@ -6,7 +6,7 @@
\newcommand{\bN}{\mathbb{N}} \newcommand{\bN}{\mathbb{N}}
\newcommand{\bC}{\mathbb{C}} \newcommand{\bC}{\mathbb{C}}
\newcommand{\bX}{\mathbb{X}} \newcommand{\bX}{\mathbb{X}}
\newcommand{\to}{\rightarrow} % \newcommand{\to}{\rightarrow}
\newcommand{\mto}{\mapsto} \newcommand{\mto}{\mapsto}
\newcommand{\UU}{\ensuremath{\mathcal{U}}\xspace} \newcommand{\UU}{\ensuremath{\mathcal{U}}\xspace}
\let\type\UU \let\type\UU

View file

@ -1,13 +1,14 @@
module Cat where module Cat where
import Cat.Cubical
import Cat.Category import Cat.Category
import Cat.Functor import Cat.Functor
import Cat.CwF
import Cat.Category.Pathy import Cat.Category.Pathy
import Cat.Category.Bij import Cat.Category.Bij
import Cat.Category.Free import Cat.Category.Free
import Cat.Category.Properties import Cat.Category.Properties
import Cat.Categories.Sets import Cat.Categories.Sets
import Cat.Categories.Cat -- import Cat.Categories.Cat
import Cat.Categories.Rel import Cat.Categories.Rel
import Cat.Categories.Fun import Cat.Categories.Fun
import Cat.Categories.Cube

View file

@ -1,3 +1,4 @@
-- There is no category of categories in our interpretation
{-# OPTIONS --cubical --allow-unsolved-metas #-} {-# OPTIONS --cubical --allow-unsolved-metas #-}
module Cat.Categories.Cat where module Cat.Categories.Cat where
@ -10,40 +11,39 @@ open import Data.Product renaming (proj₁ to fst ; proj₂ to snd)
open import Cat.Category open import Cat.Category
open import Cat.Functor open import Cat.Functor
-- Tip from Andrea: open import Cat.Equality
-- Use co-patterns - they help with showing more understandable types in goals. open Equality.Data.Product
lift-eq : {} {A B : Set } {a a' : A} {b b' : B} a a' b b' (a , b) (a' , b')
fst (lift-eq a b i) = a i
snd (lift-eq a b i) = b i
eqpair : {a b} {A : Set a} {B : Set b} {a a' : A} {b b' : B}
a a' b b' (a , b) (a' , b')
eqpair eqa eqb i = eqa i , eqb i
open Functor open Functor
open Category open IsFunctor
open Category hiding (_∘_)
-- The category of categories -- The category of categories
module _ ( ' : Level) where module _ ( ' : Level) where
private private
module _ {A B C D : Category '} {f : Functor A B} {g : Functor B C} {h : Functor C D} where module _ {𝔸 𝔹 𝔻 : Category '} {F : Functor 𝔸 𝔹} {G : Functor 𝔹 } {H : Functor 𝔻} where
private private
eq* : func* (h ∘f (g ∘f f)) func* ((h ∘f g) ∘f f) eq* : func* (H ∘f (G ∘f F)) func* ((H ∘f G) ∘f F)
eq* = refl eq* = refl
eq→ : PathP eq→ : PathP
(λ i {x y : A .Object} A .Arrow x y D .Arrow (eq* i x) (eq* i y)) (λ i {A B : 𝔸 .Object} 𝔸 [ A , B ] 𝔻 [ eq* i A , eq* i B ])
(func→ (h ∘f (g ∘f f))) (func→ ((h ∘f g) ∘f f)) (func→ (H ∘f (G ∘f F))) (func→ ((H ∘f G) ∘f F))
eq→ = refl eq→ = refl
postulate eqI : PathP postulate
(λ i {c : A .Object} eq→ i (A .𝟙 {c}) D .𝟙 {eq* i c}) eqI
(ident ((h ∘f (g ∘f f)))) : (λ i {A : 𝔸 .Object} eq→ i (𝔸 .𝟙 {A}) 𝔻 .𝟙 {eq* i A})
(ident ((h ∘f g) ∘f f)) [ (H ∘f (G ∘f F)) .isFunctor .ident
postulate eqD : PathP (λ i { c c' c'' : A .Object} {a : A .Arrow c c'} {a' : A .Arrow c' c''} ((H ∘f G) ∘f F) .isFunctor .ident
eq→ i (A ._⊕_ a' a) D ._⊕_ (eq→ i a') (eq→ i a)) ]
(distrib (h ∘f (g ∘f f))) (distrib ((h ∘f g) ∘f f)) 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 : H ∘f (G ∘f F) (H ∘f G) ∘f F
assc = Functor≡ eq* eq→ eqI eqD assc = Functor≡ eq* eq→ (IsFunctor≡ eqI eqD)
module _ { 𝔻 : Category '} {F : Functor 𝔻} where module _ { 𝔻 : Category '} {F : Functor 𝔻} where
module _ where module _ where
@ -57,16 +57,17 @@ module _ ( ' : Level) where
(func→ (F ∘f identity)) (func→ F) (func→ (F ∘f identity)) (func→ F)
eq→ = refl eq→ = refl
postulate postulate
eqI-r : PathP (λ i {c : .Object} eqI-r
PathP (λ _ Arrow 𝔻 (func* F c) (func* F c)) (func→ F ( .𝟙)) (𝔻 .𝟙)) : (λ i {c : .Object} (λ _ 𝔻 [ func* F c , func* F c ])
(ident (F ∘f identity)) (ident F) [ func→ F ( .𝟙) 𝔻 .𝟙 ])
[(F ∘f identity) .isFunctor .ident F .isFunctor .ident ]
eqD-r : PathP eqD-r : PathP
(λ i (λ i
{A B C : .Object} {f : .Arrow A B} {g : .Arrow B C} {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}
eq→ i ( ._⊕_ g f) 𝔻 ._⊕_ (eq→ i g) (eq→ i f)) eq→ i ( [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
((F ∘f identity) .distrib) (distrib F) ((F ∘f identity) .isFunctor .distrib) (F .isFunctor .distrib)
ident-r : F ∘f identity F ident-r : F ∘f identity F
ident-r = Functor≡ eq* eq→ eqI-r eqD-r ident-r = Functor≡ eq* eq→ (IsFunctor≡ eqI-r eqD-r)
module _ where module _ where
private private
postulate postulate
@ -74,13 +75,14 @@ module _ ( ' : Level) where
eq→ : PathP eq→ : PathP
(λ i {x y : Object } .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y)) (λ i {x y : Object } .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y))
((identity ∘f F) .func→) (F .func→) ((identity ∘f F) .func→) (F .func→)
eqI : PathP (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A}) eqI : (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A})
(ident (identity ∘f F)) (ident F) [ ((identity ∘f F) .isFunctor .ident) (F .isFunctor .ident) ]
eqD : PathP (λ i {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C} eqD : PathP (λ i {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}
eq→ i ( ._⊕_ g f) 𝔻 ._⊕_ (eq→ i g) (eq→ i f)) eq→ i ( [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
(distrib (identity ∘f F)) (distrib F) ((identity ∘f F) .isFunctor .distrib) (F .isFunctor .distrib)
-- (λ z → eq* i z) (eq→ i)
ident-l : identity ∘f F F ident-l : identity ∘f F F
ident-l = Functor≡ eq* eq→ eqI eqD ident-l = Functor≡ eq* eq→ λ i record { ident = eqI i ; distrib = eqD i }
Cat : Category (lsuc ( ')) ( ') Cat : Category (lsuc ( ')) ( ')
Cat = Cat =
@ -88,19 +90,18 @@ module _ ( ' : Level) where
{ Object = Category ' { Object = Category '
; Arrow = Functor ; Arrow = Functor
; 𝟙 = identity ; 𝟙 = identity
; __ = _∘f_ ; __ = _∘f_
-- What gives here? Why can I not name the variables directly? -- What gives here? Why can I not name the variables directly?
; isCategory = record ; isCategory = record
{ assoc = λ {_ _ _ _ f g h} assc {f = f} {g = g} {h = h} { assoc = λ {_ _ _ _ F G H} assc {F = F} {G = G} {H = H}
; ident = ident-r , ident-l ; ident = ident-r , ident-l
} }
} }
module _ { ' : Level} where module _ { ' : Level} where
Catt = Cat '
module _ ( 𝔻 : Category ') where module _ ( 𝔻 : Category ') where
private private
Catt = Cat '
:Object: = .Object × 𝔻 .Object :Object: = .Object × 𝔻 .Object
:Arrow: : :Object: :Object: Set ' :Arrow: : :Object: :Object: Set '
:Arrow: (c , d) (c' , d') = Arrow c c' × Arrow 𝔻 d d' :Arrow: (c , d) (c' , d') = Arrow c c' × Arrow 𝔻 d d'
@ -111,15 +112,15 @@ module _ { ' : Level} where
:Arrow: b c :Arrow: b c
:Arrow: a b :Arrow: a b
:Arrow: a c :Arrow: a c
_:⊕:_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) ( ._⊕_) bc∈C ab∈C , 𝔻 ._⊕_ bc∈D ab∈D} _:⊕:_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) [ bc∈C ab∈C ] , 𝔻 [ bc∈D ab∈D ]}
instance instance
:isCategory: : IsCategory :Object: :Arrow: :𝟙: _:⊕:_ :isCategory: : IsCategory :Object: :Arrow: :𝟙: _:⊕:_
:isCategory: = record :isCategory: = record
{ assoc = eqpair C.assoc D.assoc { assoc = Σ≡ C.assoc D.assoc
; ident ; ident
= eqpair (fst C.ident) (fst D.ident) = Σ≡ (fst C.ident) (fst D.ident)
, eqpair (snd C.ident) (snd D.ident) , Σ≡ (snd C.ident) (snd D.ident)
} }
where where
open module C = IsCategory ( .isCategory) open module C = IsCategory ( .isCategory)
@ -130,41 +131,49 @@ module _ { ' : Level} where
{ Object = :Object: { Object = :Object:
; Arrow = :Arrow: ; Arrow = :Arrow:
; 𝟙 = :𝟙: ; 𝟙 = :𝟙:
; __ = _:⊕:_ ; __ = _:⊕:_
} }
proj₁ : Arrow Catt :product: proj₁ : Catt [ :product: , ]
proj₁ = record { func* = fst ; func→ = fst ; ident = refl ; distrib = refl } proj₁ = record { func* = fst ; func→ = fst ; isFunctor = record { ident = refl ; distrib = refl } }
proj₂ : Arrow Catt :product: 𝔻 proj₂ : Catt [ :product: , 𝔻 ]
proj₂ = record { func* = snd ; func→ = snd ; ident = refl ; distrib = refl } proj₂ = record { func* = snd ; func→ = snd ; isFunctor = record { ident = refl ; distrib = refl } }
module _ {X : Object Catt} (x₁ : Arrow Catt X ) (x₂ : Arrow Catt X 𝔻) where module _ {X : Object Catt} (x₁ : Catt [ X , ]) (x₂ : Catt [ X , 𝔻 ]) where
open Functor open Functor
-- ident' : {c : Object X} → ((func→ x₁) {dom = c} (𝟙 X) , (func→ x₂) {dom = c} (𝟙 X)) ≡ 𝟙 (catProduct C D)
-- ident' {c = c} = lift-eq (ident x₁) (ident x₂)
x : Functor X :product: x : Functor X :product:
x = record x = record
{ func* = λ x (func* x₁) x , (func* x₂) x { func* = λ x x₁ .func* x , x₂ .func* x
; func→ = λ x func→ x₁ x , func→ x₂ x ; func→ = λ x func→ x₁ x , func→ x₂ x
; ident = lift-eq (ident x₁) (ident x₂) ; isFunctor = record
; distrib = lift-eq (distrib x₁) (distrib x₂) { ident = Σ≡ x₁.ident x₂.ident
; distrib = Σ≡ x₁.distrib x₂.distrib
} }
}
where
open module x = IsFunctor (x₁ .isFunctor)
open module x = IsFunctor (x₂ .isFunctor)
-- Need to "lift equality of functors" isUniqL : Catt [ proj₁ x ] x₁
-- If I want to do this like I do it for pairs it's gonna be a pain. isUniqL = Functor≡ eq* eq→ eqIsF -- Functor≡ refl refl λ i → record { ident = refl i ; distrib = refl i }
postulate isUniqL : (Catt proj₁) x x₁ where
-- isUniqL = Functor≡ refl refl {!!} {!!} eq* : (Catt [ proj₁ x ]) .func* x₁ .func*
eq* = refl
eq→ : (λ i {A : X .Object} {B : X .Object} 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₂ postulate isUniqR : Catt [ proj₂ x ] x₂
-- isUniqR = Functor≡ refl refl {!!} {!!} -- isUniqR = Functor≡ refl refl {!!} {!!}
isUniq : (Catt proj₁) x x₁ × (Catt proj₂) x x₂ isUniq : Catt [ proj₁ x ] x₁ × Catt [ proj₂ x ] x₂
isUniq = isUniqL , isUniqR isUniq = isUniqL , isUniqR
uniq : ∃![ x ] ((Catt proj₁) x x₁ × (Catt proj₂) x x₂) uniq : ∃![ x ] (Catt [ proj₁ x ] x₁ × Catt [ proj₂ x ] x₂)
uniq = x , isUniq uniq = x , isUniq
instance instance
@ -193,9 +202,6 @@ module _ ( : Level) where
Cat = Cat Cat = Cat
module _ ( 𝔻 : Category ) where module _ ( 𝔻 : Category ) where
private private
_𝔻⊕_ = 𝔻 ._⊕_
_⊕_ = ._⊕_
:obj: : Cat .Object :obj: : Cat .Object
:obj: = Fun { = } {𝔻 = 𝔻} :obj: = Fun { = } {𝔻 = 𝔻}
@ -227,13 +233,13 @@ module _ ( : Level) where
G→f : 𝔻 .Arrow (G .func* A) (G .func* B) G→f : 𝔻 .Arrow (G .func* A) (G .func* B)
G→f = G .func→ f G→f = G .func→ f
l : 𝔻 .Arrow (F .func* A) (G .func* B) l : 𝔻 .Arrow (F .func* A) (G .func* B)
l = θB 𝔻⊕ F→f l = 𝔻 [ θB F→f ]
r : 𝔻 .Arrow (F .func* A) (G .func* B) r : 𝔻 .Arrow (F .func* A) (G .func* B)
r = G→f 𝔻⊕ θA r = 𝔻 [ G→f θA ]
-- There are two choices at this point, -- There are two choices at this point,
-- but I suppose the whole point is that -- but I suppose the whole point is that
-- by `θNat f` we have `l ≡ r` -- by `θNat f` we have `l ≡ r`
-- lem : θ B 𝔻⊕ F .func→ f ≡ G .func→ f 𝔻⊕ θ A -- lem : 𝔻 [ θ B ∘ F .func→ f ] ≡ 𝔻 [ G .func→ f ∘ θ A ]
-- lem = θNat f -- lem = θNat f
result : 𝔻 .Arrow (F .func* A) (G .func* B) result : 𝔻 .Arrow (F .func* A) (G .func* B)
result = l result = l
@ -251,19 +257,20 @@ module _ ( : Level) where
-- :ident: : :func→: {c} {c} (identityNat F , .𝟙) 𝔻 .𝟙 -- :ident: : :func→: {c} {c} (identityNat F , .𝟙) 𝔻 .𝟙
-- :ident: = trans (proj₂ 𝔻.ident) (F .ident) -- :ident: = trans (proj₂ 𝔻.ident) (F .ident)
-- where -- where
-- _𝔻⊕_ = 𝔻 ._⊕_
-- open module 𝔻 = IsCategory (𝔻 .isCategory) -- open module 𝔻 = IsCategory (𝔻 .isCategory)
-- Unfortunately the equational version has some ambigous arguments. -- Unfortunately the equational version has some ambigous arguments.
:ident: : :func→: {c} {c} (identityNat F , .𝟙 {o = proj₂ c}) 𝔻 .𝟙 :ident: : :func→: {c} {c} (identityNat F , .𝟙 {o = proj₂ c}) 𝔻 .𝟙
:ident: = begin :ident: = begin
:func→: {c} {c} ((:obj: ×p ) .Product.obj .𝟙 {c}) ≡⟨⟩ :func→: {c} {c} ((:obj: ×p ) .Product.obj .𝟙 {c}) ≡⟨⟩
:func→: {c} {c} (identityNat F , .𝟙) ≡⟨⟩ :func→: {c} {c} (identityNat F , .𝟙) ≡⟨⟩
(identityTrans F C 𝔻⊕ F .func→ ( .𝟙)) ≡⟨⟩ 𝔻 [ identityTrans F C F .func→ ( .𝟙)] ≡⟨⟩
𝔻 .𝟙 𝔻⊕ F .func→ ( .𝟙) ≡⟨ proj₂ 𝔻.ident 𝔻 [ 𝔻 .𝟙 F .func→ ( .𝟙)] ≡⟨ proj₂ 𝔻.ident
F .func→ ( .𝟙) ≡⟨ F .ident F .func→ ( .𝟙) ≡⟨ F.ident
𝔻 .𝟙 𝔻 .𝟙
where where
open module 𝔻 = IsCategory (𝔻 .isCategory) open module 𝔻 = IsCategory (𝔻 .isCategory)
open module F = IsFunctor (F .isFunctor)
module _ {F×A G×B H×C : Functor 𝔻 × .Object} where module _ {F×A G×B H×C : Functor 𝔻 × .Object} where
F = F×A .proj₁ F = F×A .proj₁
A = F×A .proj₂ A = F×A .proj₂
@ -272,7 +279,7 @@ module _ ( : Level) where
H = H×C .proj₁ H = H×C .proj₁
C = H×C .proj₂ C = H×C .proj₂
-- Not entirely clear what this is at this point: -- Not entirely clear what this is at this point:
_P⊕_ = (:obj: ×p ) .Product.obj ._⊕_ {F×A} {G×B} {H×C} _P⊕_ = (:obj: ×p ) .Product.obj .Category._∘_ {F×A} {G×B} {H×C}
module _ module _
-- NaturalTransformation F G × .Arrow A B -- NaturalTransformation F G × .Arrow A B
{θ×f : NaturalTransformation F G × .Arrow A B} {θ×f : NaturalTransformation F G × .Arrow A B}
@ -292,45 +299,55 @@ module _ ( : Level) where
g = proj₂ η×g g = proj₂ η×g
ηθNT : NaturalTransformation F H ηθNT : NaturalTransformation F H
ηθNT = Fun ._⊕_ {F} {G} {H} (η , ηNat) (θ , θNat) ηθNT = Fun .Category._∘_ {F} {G} {H} (η , ηNat) (θ , θNat)
ηθ = proj₁ ηθNT ηθ = proj₁ ηθNT
ηθNat = proj₂ ηθNT ηθNat = proj₂ ηθNT
:distrib: : :distrib: :
(η C 𝔻⊕ θ C) 𝔻⊕ F .func→ (g ℂ⊕ f) 𝔻 [ 𝔻 [ η C θ C ] F .func→ ( [ g f ] ) ]
(η C 𝔻⊕ G .func→ g) 𝔻⊕ (θ B 𝔻⊕ F .func→ f) 𝔻 [ 𝔻 [ η C G .func→ g ] 𝔻 [ θ B F .func→ f ] ]
:distrib: = begin :distrib: = begin
(ηθ C) 𝔻⊕ F .func→ (g ℂ⊕ f) ≡⟨ ηθNat (g ℂ⊕ f) 𝔻 [ (ηθ C) F .func→ ( [ g f ]) ]
H .func→ (g ℂ⊕ f) 𝔻⊕ (ηθ A) ≡⟨ cong (λ φ φ 𝔻⊕ ηθ A) (H .distrib) ≡⟨ ηθNat ( [ g f ])
(H .func→ g 𝔻⊕ H .func→ f) 𝔻⊕ (ηθ A) ≡⟨ sym assoc 𝔻 [ H .func→ ( [ g f ]) (ηθ A) ]
H .func→ g 𝔻⊕ (H .func→ f 𝔻⊕ (ηθ A)) ≡⟨⟩ ≡⟨ cong (λ φ 𝔻 [ φ ηθ A ]) (H.distrib)
H .func→ g 𝔻⊕ (H .func→ f 𝔻⊕ (ηθ A)) ≡⟨ cong (λ φ H .func→ g 𝔻⊕ φ) assoc 𝔻 [ 𝔻 [ H .func→ g H .func→ f ] (ηθ A) ]
H .func→ g 𝔻⊕ ((H .func→ f 𝔻⊕ η A) 𝔻⊕ θ A) ≡⟨ cong (λ φ H .func→ g 𝔻⊕ φ) (cong (λ φ φ 𝔻⊕ θ A) (sym (ηNat f))) ≡⟨ sym assoc
H .func→ g 𝔻⊕ ((η B 𝔻⊕ G .func→ f) 𝔻⊕ θ A) ≡⟨ cong (λ φ H .func→ g 𝔻⊕ φ) (sym assoc) 𝔻 [ H .func→ g 𝔻 [ H .func→ f ηθ A ] ]
H .func→ g 𝔻⊕ (η B 𝔻⊕ (G .func→ f 𝔻⊕ θ A)) ≡⟨ assoc ≡⟨ cong (λ φ 𝔻 [ H .func→ g φ ]) assoc
(H .func→ g 𝔻⊕ η B) 𝔻⊕ (G .func→ f 𝔻⊕ θ A) ≡⟨ cong (λ φ φ 𝔻⊕ (G .func→ f 𝔻⊕ θ A)) (sym (ηNat g)) 𝔻 [ H .func→ g 𝔻 [ 𝔻 [ H .func→ f η A ] θ A ] ]
(η C 𝔻⊕ G .func→ g) 𝔻⊕ (G .func→ f 𝔻⊕ θ A) ≡⟨ cong (λ φ (η C 𝔻⊕ G .func→ g) 𝔻⊕ φ) (sym (θNat f)) ≡⟨ cong (λ φ 𝔻 [ H .func→ g φ ]) (cong (λ φ 𝔻 [ φ θ A ]) (sym (ηNat f)))
(η C 𝔻⊕ G .func→ g) 𝔻⊕ (θ B 𝔻⊕ F .func→ 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 ] ]
where where
open IsCategory (𝔻 .isCategory) open IsCategory (𝔻 .isCategory)
open module H = IsFunctor (H .isFunctor)
:eval: : Functor ((:obj: ×p ) .Product.obj) 𝔻 :eval: : Functor ((:obj: ×p ) .Product.obj) 𝔻
:eval: = record :eval: = record
{ func* = :func*: { func* = :func*:
; func→ = λ {dom} {cod} :func→: {dom} {cod} ; func→ = λ {dom} {cod} :func→: {dom} {cod}
; ident = λ {o} :ident: {o} ; isFunctor = record
{ ident = λ {o} :ident: {o}
; distrib = λ {f u n k y} :distrib: {f} {u} {n} {k} {y} ; distrib = λ {f u n k y} :distrib: {f} {u} {n} {k} {y}
} }
}
module _ (𝔸 : Category ) (F : Functor ((𝔸 ×p ) .Product.obj) 𝔻) where module _ (𝔸 : Category ) (F : Functor ((𝔸 ×p ) .Product.obj) 𝔻) where
open HasProducts (hasProducts {} {}) using (parallelProduct) open HasProducts (hasProducts {} {}) using (parallelProduct)
postulate postulate
transpose : Functor 𝔸 :obj: transpose : Functor 𝔸 :obj:
eq : Cat ._⊕_ :eval: (parallelProduct transpose (Cat .𝟙 {o = })) F eq : Cat [ :eval: (parallelProduct transpose (Cat .𝟙 {o = })) ] F
catTranspose : ∃![ F~ ] (Cat ._⊕_ :eval: (parallelProduct F~ (Cat .𝟙 {o = })) F) catTranspose : ∃![ F~ ] (Cat [ :eval: (parallelProduct F~ (Cat .𝟙 {o = }))] F )
catTranspose = transpose , eq catTranspose = transpose , eq
:isExponential: : IsExponential Cat 𝔻 :obj: :eval: :isExponential: : IsExponential Cat 𝔻 :obj: :eval:

View file

@ -0,0 +1,79 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Categories.Cube where
open import Level
open import Data.Bool hiding (T)
open import Data.Sum hiding ([_,_])
open import Data.Unit
open import Data.Empty
open import Data.Product
open import Cubical
open import Function
open import Relation.Nullary
open import Relation.Nullary.Decidable
open import Cat.Category
open import Cat.Functor
open import Cat.Equality
open Equality.Data.Product
-- See chapter 1 for a discussion on how presheaf categories are CwF's.
-- See section 6.8 in Huber's thesis for details on how to implement the
-- categorical version of CTT
open Category hiding (_∘_)
open Functor
module _ { ' : Level} (Ns : Set ) where
-- Ns is the "namespace"
o = (suc zero )
FiniteDecidableSubset : Set
FiniteDecidableSubset = Ns Dec
isTrue : Bool Set
isTrue false =
isTrue true =
elmsof : FiniteDecidableSubset Set
elmsof P = Σ Ns (λ σ True (P σ)) -- (σ : Ns) → isTrue (P σ)
𝟚 : Set
𝟚 = Bool
module _ (I J : FiniteDecidableSubset) where
private
Hom' : Set
Hom' = elmsof I elmsof J 𝟚
isInl : {a b : Level} {A : Set a} {B : Set b} A B Set
isInl (inj₁ _) =
isInl (inj₂ _) =
Def : Set
Def = (f : Hom') Σ (elmsof I) (λ i isInl (f i))
rules : Hom' Set
rules f = (i j : elmsof I)
case (f i) of λ
{ (inj₁ (fi , _)) case (f j) of λ
{ (inj₁ (fj , _)) fi fj i j
; (inj₂ _) Lift
}
; (inj₂ _) Lift
}
Hom = Σ Hom' rules
-- The category of names and substitutions
Raw : RawCategory -- o (lsuc lzero ⊔ o)
Raw = record
{ Object = FiniteDecidableSubset
-- { Object = Ns → Bool
; Arrow = Hom
; 𝟙 = λ { {o} inj₁ , λ { (i , ii) (j , jj) eq Σ≡ eq {!refl!} } }
; _∘_ = {!!}
}
postulate RawIsCategory : IsCategory Raw
: Category
= Raw , RawIsCategory

View file

@ -0,0 +1,54 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Categories.Fam where
open import Agda.Primitive
open import Data.Product
open import Cubical
import Function
open import Cat.Category
open import Cat.Equality
open Equality.Data.Product
module _ (a b : Level) where
private
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
proj₁ one = λ x x
proj₂ one = λ b b
_∘_ : {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
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
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 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 = RawFam , isCategory

View file

@ -10,19 +10,19 @@ open import Cat.Category
open import Cat.Functor open import Cat.Functor
module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Category d d'} where module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Category d d'} where
open Category open Category hiding ( _∘_ ; Arrow )
open Functor open Functor
module _ (F G : Functor 𝔻) where module _ (F G : Functor 𝔻) where
-- What do you call a non-natural tranformation? -- What do you call a non-natural tranformation?
Transformation : Set (c d') Transformation : Set (c d')
Transformation = (C : .Object) 𝔻 .Arrow (F .func* C) (G .func* C) Transformation = (C : .Object) 𝔻 [ F .func* C , G .func* C ]
Natural : Transformation Set (c (c' d')) Natural : Transformation Set (c (c' d'))
Natural θ Natural θ
= {A B : .Object} = {A B : .Object}
(f : .Arrow A B) (f : [ A , B ])
𝔻 ._⊕_ (θ B) (F .func→ f) 𝔻 ._⊕_ (G .func→ f) (θ A) 𝔻 [ θ B F .func→ f ] 𝔻 [ G .func→ f θ A ]
NaturalTransformation : Set (c c' d') NaturalTransformation : Set (c c' d')
NaturalTransformation = Σ Transformation Natural NaturalTransformation = Σ Transformation Natural
@ -30,43 +30,53 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
-- NaturalTranformation : Set (c ⊔ (c' ⊔ d')) -- NaturalTranformation : Set (c ⊔ (c' ⊔ d'))
-- NaturalTranformation = ∀ (θ : Transformation) {A B : .Object} → (f : .Arrow A B) → 𝔻 ._⊕_ (θ B) (F .func→ f) ≡ 𝔻 ._⊕_ (G .func→ f) (θ A) -- NaturalTranformation = ∀ (θ : Transformation) {A B : .Object} → (f : .Arrow A B) → 𝔻 ._⊕_ (θ B) (F .func→ f) ≡ 𝔻 ._⊕_ (G .func→ f) (θ A)
module _ {F G : Functor 𝔻} where
NaturalTransformation≡ : {α β : NaturalTransformation F G}
(eq₁ : α .proj₁ β .proj₁)
(eq₂ : PathP
(λ i {A B : .Object} (f : [ A , B ])
𝔻 [ eq₁ i B F .func→ f ]
𝔻 [ G .func→ f eq₁ i A ])
(α .proj₂) (β .proj₂))
α β
NaturalTransformation≡ eq₁ eq₂ i = eq₁ i , eq₂ i
identityTrans : (F : Functor 𝔻) Transformation F F identityTrans : (F : Functor 𝔻) Transformation F F
identityTrans F C = 𝔻 .𝟙 identityTrans F C = 𝔻 .𝟙
identityNatural : (F : Functor 𝔻) Natural F F (identityTrans F) identityNatural : (F : Functor 𝔻) Natural F F (identityTrans F)
identityNatural F {A = A} {B = B} f = begin identityNatural F {A = A} {B = B} f = begin
identityTrans F B 𝔻⊕ F→ f ≡⟨⟩ 𝔻 [ identityTrans F B F→ f ] ≡⟨⟩
𝔻 .𝟙 𝔻⊕ F→ f ≡⟨ proj₂ 𝔻.ident 𝔻 [ 𝔻 .𝟙 F→ f ] ≡⟨ proj₂ 𝔻.ident
F→ f ≡⟨ sym (proj₁ 𝔻.ident) F→ f ≡⟨ sym (proj₁ 𝔻.ident)
F→ f 𝔻⊕ 𝔻 .𝟙 ≡⟨⟩ 𝔻 [ F→ f 𝔻 .𝟙 ] ≡⟨⟩
F→ f 𝔻⊕ identityTrans F A 𝔻 [ F→ f identityTrans F A ]
where where
_𝔻⊕_ = 𝔻 ._⊕_
F→ = F .func→ F→ = F .func→
open module 𝔻 = IsCategory (𝔻 .isCategory) module 𝔻 = IsCategory (isCategory 𝔻)
identityNat : (F : Functor 𝔻) NaturalTransformation F F identityNat : (F : Functor 𝔻) NaturalTransformation F F
identityNat F = identityTrans F , identityNatural F identityNat F = identityTrans F , identityNatural F
module _ {F G H : Functor 𝔻} where module _ {F G H : Functor 𝔻} where
private private
_𝔻⊕_ = 𝔻 ._⊕_
_∘nt_ : Transformation G H Transformation F G Transformation F H _∘nt_ : Transformation G H Transformation F G Transformation F H
(θ ∘nt η) C = θ C 𝔻⊕ η C (θ ∘nt η) C = 𝔻 [ θ C η C ]
NatComp _:⊕:_ : NaturalTransformation G H NaturalTransformation F G NaturalTransformation F H NatComp _:⊕:_ : NaturalTransformation G H NaturalTransformation F G NaturalTransformation F H
proj₁ ((θ , _) :⊕: (η , _)) = θ ∘nt η proj₁ ((θ , _) :⊕: (η , _)) = θ ∘nt η
proj₂ ((θ , θNat) :⊕: (η , ηNat)) {A} {B} f = begin proj₂ ((θ , θNat) :⊕: (η , ηNat)) {A} {B} f = begin
((θ ∘nt η) B) 𝔻⊕ (F .func→ f) ≡⟨⟩ 𝔻 [ (θ ∘nt η) B F .func→ f ] ≡⟨⟩
(θ B 𝔻⊕ η B) 𝔻⊕ (F .func→ f) ≡⟨ sym assoc 𝔻 [ 𝔻 [ θ B η B ] F .func→ f ] ≡⟨ sym assoc
θ B 𝔻⊕ (η B 𝔻⊕ (F .func→ f)) ≡⟨ cong (λ φ θ B 𝔻⊕ φ) (ηNat f) 𝔻 [ θ B 𝔻 [ η B F .func→ f ] ] ≡⟨ cong (λ φ 𝔻 [ θ B φ ]) (ηNat f)
θ B 𝔻⊕ ((G .func→ f) 𝔻⊕ η A) ≡⟨ assoc 𝔻 [ θ B 𝔻 [ G .func→ f η A ] ] ≡⟨ assoc
(θ B 𝔻⊕ (G .func→ f)) 𝔻⊕ η A ≡⟨ cong (λ φ φ 𝔻⊕ η A) (θNat f) 𝔻 [ 𝔻 [ θ B G .func→ f ] η A ] ≡⟨ cong (λ φ 𝔻 [ φ η A ]) (θNat f)
(((H .func→ f) 𝔻⊕ θ A) 𝔻⊕ η A) ≡⟨ sym assoc 𝔻 [ 𝔻 [ H .func→ f θ A ] η A ] ≡⟨ sym assoc
((H .func→ f) 𝔻⊕ (θ A 𝔻⊕ η A)) ≡⟨⟩ 𝔻 [ H .func→ f 𝔻 [ θ A η A ] ] ≡⟨⟩
((H .func→ f) 𝔻⊕ ((θ ∘nt η) A)) 𝔻 [ H .func→ f (θ ∘nt η) A ]
where where
open IsCategory (𝔻 .isCategory) open IsCategory (isCategory 𝔻)
NatComp = _:⊕:_ NatComp = _:⊕:_
private private
@ -86,31 +96,35 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
× (_:⊕:_ {A} {B} {B} (identityNat B) f) f × (_:⊕:_ {A} {B} {B} (identityNat B) f) f
:ident: = ident-r , ident-l :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. -- Functor categories. Objects are functors, arrows are natural transformations.
Fun : Category (c c' d d') (c c' d') RawFun : RawCategory (c c' d d') (c c' d')
Fun = record RawFun = record
{ Object = Functor 𝔻 { Object = Functor 𝔻
; Arrow = NaturalTransformation ; Arrow = NaturalTransformation
; 𝟙 = λ {F} identityNat F ; 𝟙 = λ {F} identityNat F
; __ = λ {F G H} _:⊕:_ {F} {G} {H} ; _∘_ = λ {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 module _ { ' : Level} ( : Category ') where
open import Cat.Categories.Sets open import Cat.Categories.Sets
-- Restrict the functors to Presheafs. -- Restrict the functors to Presheafs.
Presh : Category ( lsuc ') ( ') RawPresh : RawCategory ( lsuc ') ( ')
Presh = record RawPresh = record
{ Object = Presheaf { Object = Presheaf
; Arrow = NaturalTransformation ; Arrow = NaturalTransformation
; 𝟙 = λ {F} identityNat F ; 𝟙 = λ {F} identityNat F
; _⊕_ = λ {F G H} NatComp {F = F} {G = G} {H = H} ; __ = λ {F G H} NatComp {F = F} {G = G} {H = H}
} }

View file

@ -1,4 +1,4 @@
{-# OPTIONS --cubical #-} {-# OPTIONS --cubical --allow-unsolved-metas #-}
module Cat.Categories.Rel where module Cat.Categories.Rel where
open import Cubical open import Cubical
@ -154,11 +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)) (Σ[ b B ] (a , b) S × (Σ[ c C ] (b , c) R × (c , d) Q))
is-assoc = equivToPath equi is-assoc = equivToPath equi
Rel : Category (lsuc lzero) (lsuc lzero) RawRel : RawCategory (lsuc lzero) (lsuc lzero)
Rel = record RawRel = record
{ Object = Set { Object = Set
; Arrow = λ S R Subset (S × R) ; Arrow = λ S R Subset (S × R)
; 𝟙 = λ {S} Diag S ; 𝟙 = λ {S} Diag S
; _⊕_ = λ {A B C} S R λ {( a , c ) Σ[ b B ] ( (a , b) R × (b , c) 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 } }
RawIsCategoryRel : IsCategory RawRel
RawIsCategoryRel = record
{ assoc = funExt is-assoc
; ident = funExt ident-l , funExt ident-r
; arrow-is-set = {!!}
; univalent = {!!}
} }

View file

@ -1,41 +1,49 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Categories.Sets where module Cat.Categories.Sets where
open import Cubical open import Cubical
open import Agda.Primitive open import Agda.Primitive
open import Data.Product open import Data.Product
open import Data.Product renaming (proj₁ to fst ; proj₂ to snd) import Function
open import Cat.Category open import Cat.Category
open import Cat.Functor open import Cat.Functor
open Category open Category
module _ { : Level} where module _ { : Level} where
Sets : Category (lsuc ) SetsRaw : RawCategory (lsuc )
Sets = record SetsRaw = record
{ Object = Set { Object = Set
; Arrow = λ T U T U ; Arrow = λ T U T U
; 𝟙 = id ; 𝟙 = Function.id
; _⊕_ = _∘_ ; _∘_ = Function._∘_
; isCategory = record { assoc = refl ; ident = funExt (λ _ refl) , funExt (λ _ refl) }
} }
where
open import Function SetsIsCategory : IsCategory SetsRaw
SetsIsCategory = record
{ assoc = refl
; ident = funExt (λ _ refl) , funExt (λ _ refl)
; arrow-is-set = {!!}
; univalent = {!!}
}
Sets : Category (lsuc )
Sets = SetsRaw , SetsIsCategory
private private
module _ {X A B : Set } (f : X A) (g : X B) where module _ {X A B : Set } (f : X A) (g : X B) where
_&&&_ : (X A × B) _&&&_ : (X A × B)
_&&&_ x = f x , g x _&&&_ x = f x , g x
module _ {X A B : Set } (f : X A) (g : X B) where module _ {X A B : Set } (f : X A) (g : X B) where
_S⊕_ = Sets ._⊕_ lem : Sets [ proj₁ (f &&& g)] f × Sets [ proj₂ (f &&& g)] g
lem : proj₁ S⊕ (f &&& g) f × snd S⊕ (f &&& g) g
proj₁ lem = refl proj₁ lem = refl
proj₂ lem = refl proj₂ lem = refl
instance instance
isProduct : {A B : Sets .Object} IsProduct Sets {A} {B} fst snd isProduct : {A B : Sets .Object} IsProduct Sets {A} {B} proj₁ proj₂
isProduct f g = f &&& g , lem f g isProduct f g = f &&& g , lem f g
product : (A B : Sets .Object) Product { = Sets} A B product : (A B : Sets .Object) Product { = Sets} A B
product A B = record { obj = A × B ; proj₁ = fst ; proj₂ = snd ; isProduct = isProduct } product A B = record { obj = A × B ; proj₁ = proj₁ ; proj₂ = proj₂ ; isProduct = isProduct }
instance instance
SetsHasProducts : HasProducts Sets SetsHasProducts : HasProducts Sets
@ -49,12 +57,14 @@ Representable {' = '} = Functor (Sets {'})
representable : { '} { : Category '} Category.Object Representable representable : { '} { : Category '} Category.Object Representable
representable { = } A = record representable { = } A = record
{ func* = λ B .Arrow A B { func* = λ B .Arrow A B
; func→ = ._⊕_ ; func→ = ._∘_
; ident = funExt λ _ snd ident ; isFunctor = record
{ ident = funExt λ _ proj₂ ident
; distrib = funExt λ x sym assoc ; distrib = funExt λ x sym assoc
} }
}
where where
open IsCategory ( .isCategory) open IsCategory (isCategory )
-- Contravariant Presheaf -- Contravariant Presheaf
Presheaf : { '} ( : Category ') Set ( lsuc ') Presheaf : { '} ( : Category ') Set ( lsuc ')
@ -64,9 +74,11 @@ Presheaf {' = '} = Functor (Opposite ) (Sets {'})
presheaf : { ' : Level} { : Category '} Category.Object (Opposite ) Presheaf presheaf : { ' : Level} { : Category '} Category.Object (Opposite ) Presheaf
presheaf { = } B = record presheaf { = } B = record
{ func* = λ A .Arrow A B { func* = λ A .Arrow A B
; func→ = λ f g ._⊕_ g f ; func→ = λ f g ._∘_ g f
; ident = funExt λ x fst ident ; isFunctor = record
{ ident = funExt λ x proj₁ ident
; distrib = funExt λ x assoc ; distrib = funExt λ x assoc
} }
}
where where
open IsCategory ( .isCategory) open IsCategory (isCategory )

View file

@ -1,4 +1,4 @@
{-# OPTIONS --cubical #-} {-# OPTIONS --allow-unsolved-metas --cubical #-}
module Cat.Category where module Cat.Category where
@ -10,8 +10,9 @@ open import Data.Product renaming
; ∃! to ∃!≈ ; ∃! to ∃!≈
) )
open import Data.Empty open import Data.Empty
open import Function import Function
open import Cubical open import Cubical
open import Cubical.GradLemma using ( propIsEquiv )
∃! : {a b} {A : Set a} ∃! : {a b} {A : Set a}
(A Set b) Set (a b) (A Set b) Set (a b)
@ -22,57 +23,119 @@ open import Cubical
syntax ∃!-syntax (λ x B) = ∃![ x ] B syntax ∃!-syntax (λ x B) = ∃![ x ] B
record IsCategory { ' : Level} record RawCategory ( ' : Level) : Set (lsuc (' )) where
(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
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
ident : {A B : Object} {f : Arrow A B}
f 𝟙 f × 𝟙 f f
-- open IsCategory public
record Category ( ' : Level) : Set (lsuc (' )) where
-- adding no-eta-equality can speed up type-checking. -- adding no-eta-equality can speed up type-checking.
-- ONLY IF you define your categories with copatterns though.
no-eta-equality no-eta-equality
field field
-- Need something like:
-- Object : Σ (Set ) isGroupoid
Object : Set Object : Set
-- And:
-- Arrow : Object → Object → Σ (Set ') isSet
Arrow : Object Object Set ' Arrow : Object Object Set '
𝟙 : {o : Object} Arrow o o 𝟙 : {o : Object} Arrow o o
_⊕_ : { a b c : Object } Arrow b c Arrow a b Arrow a c _∘_ : {A B C : Object} Arrow B C Arrow A B Arrow A C
{{isCategory}} : IsCategory Object Arrow 𝟙 _⊕_ infixl 10 _∘_
infixl 45 _⊕_
domain : { a b : Object } Arrow a b Object domain : { a b : Object } Arrow a b Object
domain {a = a} _ = a domain {a = a} _ = a
codomain : { a b : Object } Arrow a b Object codomain : { a b : Object } Arrow a b Object
codomain {b = b} _ = b codomain {b = b} _ = b
open Category -- Thierry: All projections must be `isProp`'s
module _ { ' : Level} { : Category '} where -- According to definitions 9.1.1 and 9.1.6 in the HoTT book the
module _ { A B : .Object } where -- arrows of a category form a set (arrow-is-set), and there is an
Isomorphism : (f : .Arrow A B) Set ' -- equivalence between the equality of objects and isomorphisms
Isomorphism f = Σ[ g .Arrow B A ] ._⊕_ g f .𝟙 × ._⊕_ f g .𝟙 -- (univalent).
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
ident : {A B : Object} {f : Arrow A B}
f 𝟙 f × 𝟙 f f
arrow-is-set : {A B : Object} isSet (Arrow A B)
Epimorphism : {X : .Object } (f : .Arrow A B) Set ' Isomorphism : {A B} (f : Arrow A B) Set b
Epimorphism {X} f = ( g₀ g₁ : .Arrow B X ) ._⊕_ g₀ f ._⊕_ g₁ f g₀ g₁ Isomorphism {A} {B} f = Σ[ g Arrow B A ] g f 𝟙 × f g 𝟙
Monomorphism : {X : .Object} (f : .Arrow A B) Set ' _≅_ : (A B : Object) Set b
Monomorphism {X} f = ( g₀ g₁ : .Arrow X A ) ._⊕_ f g₀ ._⊕_ f g₁ g₀ g₁ _≅_ A B = Σ[ f Arrow A B ] (Isomorphism f)
-- Isomorphism of objects idIso : (A : Object) A A
_≅_ : (A B : Object ) Set ' idIso A = 𝟙 , (𝟙 , ident)
_≅_ A B = Σ[ f .Arrow A B ] (Isomorphism f)
module _ { ' : Level} ( : Category ') {A B obj : Object } where id-to-iso : (A B : Object) A B A B
IsProduct : (π₁ : Arrow obj A) (π₂ : Arrow obj B) Set ( ') id-to-iso A B eq = transp (\ i A eq i) (idIso A)
-- TODO: might want to implement isEquiv differently, there are 3
-- equivalent formulations in the book.
field
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 b
Epimorphism {X} f = ( g₀ g₁ : Arrow B X ) g₀ f g₁ f g₀ g₁
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} { : 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
{ assoc = x.arrow-is-set _ _ x.assoc y.assoc i
; ident =
( x.arrow-is-set _ _ (fst x.ident) (fst y.ident) i
, x.arrow-is-set _ _ (snd x.ident) (snd y.ident) i
)
-- ; arrow-is-set = {!λ x₁ y₁ p q → x.arrow-is-set _ _ p q!}
; arrow-is-set = λ _ _ p q
let
golden : x.arrow-is-set _ _ p q y.arrow-is-set _ _ p q
golden = λ j k l {!!}
in
golden i
; univalent = λ y₁ {!!}
}
where
module x = IsCategory x
module y = IsCategory y
Category : (a b : Level) Set (lsuc (a b))
Category a b = Σ (RawCategory a b) IsCategory
module Category {a b : Level} ( : Category a b) where
raw = fst
open RawCategory raw public
isCategory = snd
open RawCategory
-- _∈_ : ∀ {a b} ( : Category a b) → ( .fst .Object → Set b) → Set (a ⊔ b)
-- A ∈ =
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 π₁ π₂ IsProduct π₁ π₂
= {X : .Object} (x₁ : .Arrow X A) (x₂ : .Arrow X B) = {X : Obj } (x₁ : [ X , A ]) (x₂ : [ X , B ])
∃![ x ] ( ._⊕_ π₁ x x₁ × ._⊕_ π₂ x x₂) ∃![ x ] ( [ π₁ x ] x₁ × [ π₂ x ] x₂)
-- Tip from Andrea; Consider this style for efficiency: -- Tip from Andrea; Consider this style for efficiency:
-- record IsProduct { ' : Level} ( : Category {} {'}) -- record IsProduct { ' : Level} ( : Category {} {'})
@ -81,46 +144,55 @@ module _ { ' : Level} ( : Category ') {A B obj : Object } whe
-- isProduct : ∀ {X : .Object} (x₁ : .Arrow X A) (x₂ : .Arrow X B) -- isProduct : ∀ {X : .Object} (x₁ : .Arrow X A) (x₂ : .Arrow X B)
-- → ∃![ x ] ( ._⊕_ π₁ x ≡ x₁ × . _⊕_ π₂ x ≡ x₂) -- → ∃![ 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 no-eta-equality
field field
obj : .Object obj : Obj
proj₁ : .Arrow obj A proj₁ : [ obj , A ]
proj₂ : .Arrow obj B proj₂ : [ obj , B ]
{{isProduct}} : IsProduct proj₁ proj₂ {{isProduct}} : IsProduct proj₁ proj₂
arrowProduct : {X} (π₁ : Arrow X A) (π₂ : Arrow X B) arrowProduct : {X} (π₁ : [ X , A ]) (π₂ : [ X , B ])
Arrow X obj [ X , obj ]
arrowProduct π₁ π₂ = fst (isProduct π₁ π₂) arrowProduct π₁ π₂ = fst (isProduct π₁ π₂)
record HasProducts { ' : Level} ( : Category ') : Set ( ') where record HasProducts { ' : Level} ( : Category ') : Set ( ') where
field field
product : (A B : .Object) Product { = } A B product : (A B : Obj ) Product { = } A B
open Product open Product
objectProduct : (A B : .Object) .Object objectProduct : (A B : Obj ) Obj
objectProduct A B = Product.obj (product A B) objectProduct A B = Product.obj (product A B)
-- The product mentioned in awodey in Def 6.1 is not the regular product of arrows. -- The product mentioned in awodey in Def 6.1 is not the regular product of arrows.
-- It's a "parallel" product -- It's a "parallel" product
parallelProduct : {A A' B B' : .Object} .Arrow A A' .Arrow B B' parallelProduct : {A A' B B' : Obj } [ A , A' ] [ B , B' ]
.Arrow (objectProduct A B) (objectProduct A' B') [ objectProduct A B , objectProduct A' B' ]
parallelProduct {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B') parallelProduct {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B')
( ._⊕_ a ((product A B) .proj₁)) ( [ a (product A B) .proj₁ ])
( ._⊕_ b ((product A B) .proj₂)) ( [ b (product A B) .proj₂ ])
module _ { ' : Level} ( : Category ') where module _ {a b : Level} ( : Category a b) where
Opposite : Category ' private
Opposite = open Category
record module = RawCategory ( .fst)
{ Object = .Object OpRaw : RawCategory a b
; Arrow = flip ( .Arrow) OpRaw = record
; 𝟙 = .𝟙 { Object = .Object
; _⊕_ = flip ( ._⊕_) ; Arrow = Function.flip .Arrow
; isCategory = record { assoc = sym assoc ; ident = swap ident } ; 𝟙 = .𝟙
; _∘_ = 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 -- A consequence of no-eta-equality; `Opposite-is-involution` is no longer
-- definitional - i.e.; you must match on the fields: -- definitional - i.e.; you must match on the fields:
@ -133,44 +205,52 @@ module _ { ' : Level} ( : Category ') where
-- assoc (Opposite-is-involution i) = {!!} -- assoc (Opposite-is-involution i) = {!!}
-- ident (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 module _ { '} ( : Category ') {{hasProducts : HasProducts }} where
open HasProducts hasProducts open HasProducts hasProducts
open Product hiding (obj) open Product hiding (obj)
private private
_×p_ : (A B : .Object) .Object _×p_ : (A B : Obj ) Obj
_×p_ A B = Product.obj (product A B) _×p_ A B = Product.obj (product A B)
module _ (B C : .Category.Object) where module _ (B C : Obj ) where
IsExponential : (Cᴮ : .Object) .Arrow (Cᴮ ×p B) C Set ( ') IsExponential : (Cᴮ : Obj ) [ Cᴮ ×p B , C ] Set ( ')
IsExponential Cᴮ eval = (A : .Object) (f : .Arrow (A ×p B) C) IsExponential Cᴮ eval = (A : Obj ) (f : [ A ×p B , C ])
∃![ f~ ] ( ._⊕_ eval (parallelProduct f~ ( .𝟙)) f) ∃![ f~ ] ( [ eval parallelProduct f~ (Category.raw .𝟙)] f)
record Exponential : Set ( ') where record Exponential : Set ( ') where
field field
-- obj ≡ Cᴮ -- obj ≡ Cᴮ
obj : .Object obj : Obj
eval : .Arrow ( obj ×p B ) C eval : [ obj ×p B , C ]
{{isExponential}} : IsExponential obj eval {{isExponential}} : IsExponential obj eval
-- If I make this an instance-argument then the instance resolution -- If I make this an instance-argument then the instance resolution
-- algorithm goes into an infinite loop. Why? -- algorithm goes into an infinite loop. Why?
exponentialsHaveProducts : HasProducts exponentialsHaveProducts : HasProducts
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) transpose A f = fst (isExponential A f)
record HasExponentials { ' : Level} ( : Category ') {{_ : HasProducts }} : Set ( ') where record HasExponentials { ' : Level} ( : Category ') {{_ : HasProducts }} : Set ( ') where
field field
exponent : (A B : .Object) Exponential A B exponent : (A B : Obj ) Exponential A B
record CartesianClosed { ' : Level} ( : Category ') : Set ( ') where record CartesianClosed { ' : Level} ( : Category ') : Set ( ') where
field field
{{hasProducts}} : HasProducts {{hasProducts}} : HasProducts
{{hasExponentials}} : HasExponentials {{hasExponentials}} : HasExponentials
module _ {a b : Level} ( : Category a b) where
unique = isContr
IsInitial : Obj Set (a b)
IsInitial I = {X : Obj } unique ( [ I , X ])
IsTerminal : Obj Set (a b)
-- ∃![ ? ] ?
IsTerminal T = {X : Obj } unique ( [ X , T ])
Initial : Set (a b)
Initial = Σ (Obj ) IsInitial
Terminal : Set (a b)
Terminal = Σ (Obj ) IsTerminal

View file

@ -1,3 +1,4 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Category.Free where module Cat.Category.Free where
open import Agda.Primitive open import Agda.Primitive
@ -9,28 +10,33 @@ open import Cat.Category as C
module _ { ' : Level} ( : Category ') where module _ { ' : Level} ( : Category ') where
private private
open module = Category open module = Category
Obj = .Object
postulate postulate
Path : ( a b : Obj ) Set ' Path : ( a b : Obj ) Set '
emptyPath : (o : Obj) Path o o emptyPath : (o : Obj ) Path o o
concatenate : {a b c : Obj} Path b c Path a b Path a c concatenate : {a b c : Obj } Path b c Path a b Path a c
private 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 postulate
p-assoc : concatenate {A} {C} {D} p (concatenate {A} {B} {C} q r) p-assoc : concatenate {A} {C} {D} p (concatenate {A} {B} {C} q r)
concatenate {A} {B} {D} (concatenate {B} {C} {D} p 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 postulate
ident-r : concatenate {A} {A} {B} p (emptyPath A) p ident-r : concatenate {A} {A} {B} p (emptyPath A) p
ident-l : concatenate {A} {B} {B} (emptyPath B) p p ident-l : concatenate {A} {B} {B} (emptyPath B) p p
Free : Category ' RawFree : RawCategory '
Free = record RawFree = record
{ Object = Obj { Object = Obj
; Arrow = Path ; Arrow = Path
; 𝟙 = λ {o} emptyPath o ; 𝟙 = λ {o} emptyPath o
; _⊕_ = λ {a b c} concatenate {a} {b} {c} ; _∘_ = λ {a b c} concatenate {a} {b} {c}
; isCategory = record { assoc = p-assoc ; ident = ident-r , ident-l } }
RawIsCategoryFree : IsCategory RawFree
RawIsCategoryFree = record
{ assoc = p-assoc
; ident = ident-r , ident-l
; arrow-is-set = {!!}
; univalent = {!!}
} }

View file

@ -9,36 +9,37 @@ open import Cubical
open import Cat.Category open import Cat.Category
open import Cat.Functor open import Cat.Functor
open import Cat.Categories.Sets open import Cat.Categories.Sets
open import Cat.Equality
open Equality.Data.Product
module _ { ' : Level} { : Category '} { A B : .Category.Object } {X : .Category.Object} (f : .Category.Arrow A B) where module _ { ' : Level} { : Category '} { A B : .Category.Object } {X : .Category.Object} (f : .Category.Arrow A B) where
open Category open Category
open IsCategory (isCategory) open IsCategory (isCategory)
iso-is-epi : Isomorphism { = } f Epimorphism { = } {X = X} f iso-is-epi : Isomorphism f Epimorphism {X = X} f
iso-is-epi (f- , left-inv , right-inv) g₀ g₁ eq = iso-is-epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
begin
g₀ ≡⟨ sym (proj₁ ident) g₀ ≡⟨ sym (proj₁ ident)
g₀ 𝟙 ≡⟨ cong (__ g₀) (sym right-inv) g₀ 𝟙 ≡⟨ cong (__ g₀) (sym right-inv)
g₀ (f f-) ≡⟨ assoc g₀ (f f-) ≡⟨ assoc
(g₀ f) f- ≡⟨ cong (λ φ φ f-) eq (g₀ f) f- ≡⟨ cong (λ φ φ f-) eq
(g₁ f) f- ≡⟨ sym assoc (g₁ f) f- ≡⟨ sym assoc
g₁ (f f-) ≡⟨ cong (_⊕_ g₁) right-inv g₁ (f f-) ≡⟨ cong (_∘_ g₁) right-inv
g₁ 𝟙 ≡⟨ proj₁ ident g₁ 𝟙 ≡⟨ proj₁ ident
g₁ g₁
iso-is-mono : Isomorphism { = } f Monomorphism { = } {X = X} f iso-is-mono : Isomorphism f Monomorphism {X = X} f
iso-is-mono (f- , (left-inv , right-inv)) g₀ g₁ eq = iso-is-mono (f- , (left-inv , right-inv)) g₀ g₁ eq =
begin begin
g₀ ≡⟨ sym (proj₂ ident) g₀ ≡⟨ sym (proj₂ ident)
𝟙 g₀ ≡⟨ cong (λ φ φ g₀) (sym left-inv) 𝟙 g₀ ≡⟨ cong (λ φ φ g₀) (sym left-inv)
(f- f) g₀ ≡⟨ sym assoc (f- f) g₀ ≡⟨ sym assoc
f- (f g₀) ≡⟨ cong (_⊕_ f-) eq f- (f g₀) ≡⟨ cong (_∘_ f-) eq
f- (f g₁) ≡⟨ assoc f- (f g₁) ≡⟨ assoc
(f- f) g₁ ≡⟨ cong (λ φ φ g₁) left-inv (f- f) g₁ ≡⟨ cong (λ φ φ g₁) left-inv
𝟙 g₁ ≡⟨ proj₂ ident 𝟙 g₁ ≡⟨ proj₂ ident
g₁ g₁
iso-is-epi-mono : Isomorphism { = } f Epimorphism { = } {X = X} f × Monomorphism { = } {X = X} f 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 iso-is-epi-mono iso = iso-is-epi iso , iso-is-mono iso
{- {-
@ -48,45 +49,76 @@ epi-mono-is-not-iso f =
in {!!} in {!!}
-} -}
module _ { : Level} { : Category } where open import Cat.Category
open import Cat.Category open Category
open Category open import Cat.Functor
open import Cat.Categories.Cat using (Cat) open Functor
open import Cat.Categories.Fun
open import Cat.Categories.Sets
module Cat = Cat.Categories.Cat
open Exponential
private
Cat = Cat
prshf = presheaf { = }
-- Exp : Set (lsuc (lsuc )) -- module _ { : Level} { : Category }
-- Exp = Exponential (Cat (lsuc ) ) -- {isSObj : isSet ( .Object)}
-- Sets (Opposite ) -- {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 Exponential
-- private
-- Cat = Cat
-- prshf = presheaf { = }
-- module = IsCategory ( .isCategory)
_⇑_ : (A B : Cat .Object) Cat .Object -- -- Exp : Set (lsuc (lsuc ))
A B = (exponent A B) .obj -- -- Exp = Exponential (Cat (lsuc ) )
where -- -- Sets (Opposite )
open HasExponentials (Cat.hasExponentials )
module _ {A B : .Object} (f : .Arrow A B) where -- _⇑_ : (A B : Cat .Object) → Cat .Object
:func→: : NaturalTransformation (prshf A) (prshf B) -- A ⇑ B = (exponent A B) .obj
:func→: = (λ C x ( ._⊕_ f x)) , λ f₁ funExt λ x lem -- where
where -- open HasExponentials (Cat.hasExponentials )
lem = ( .isCategory) .IsCategory.assoc
module _ {c : .Object} where
eqTrans : (:func→: ( .𝟙 {c})) .proj₁ (Fun .𝟙 {o = prshf c}) .proj₁
eqTrans = funExt λ x funExt λ x .isCategory .IsCategory.ident .proj₂
eqNat : (i : I) Natural (prshf c) (prshf c) (eqTrans i)
eqNat i f = {!!}
:ident: : (:func→: ( .𝟙 {c})) (Fun .𝟙 {o = prshf c}) -- module _ {A B : .Object} (f : .Arrow A B) where
:ident: i = eqTrans i , eqNat i -- :func→: : NaturalTransformation (prshf A) (prshf B)
-- :func→: = (λ C x [ f x ]) , λ f₁ funExt λ _ .assoc
yoneda : Functor (Fun { = Opposite } {𝔻 = Sets {}}) -- module _ {c : .Object} where
yoneda = record -- eqTrans : (λ _ → Transformation (prshf c) (prshf c))
{ func* = prshf -- [ (λ _ x → [ .𝟙 ∘ x ]) ≡ identityTrans (prshf c) ]
; func→ = :func→: -- eqTrans = funExt λ x → funExt λ x → .ident .proj₂
; ident = :ident:
; distrib = {!!} -- 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 = {!!}
-- }
-- }

View file

@ -1,101 +0,0 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Cubical where
open import Agda.Primitive
open import Data.Bool
open import Data.Product
open import Data.Sum
open import Data.Unit
open import Data.Empty
open import Data.Product
open import Cat.Category
open import Cat.Functor
-- See chapter 1 for a discussion on how presheaf categories are CwF's.
-- See section 6.8 in Huber's thesis for details on how to implement the
-- categorical version of CTT
module CwF { ' : Level} ( : Category ') where
open Category
open Functor
open import Function
open import Cubical
module _ {a b : Level} where
private
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
proj₁ one = λ x x
proj₂ one = λ b b
_:⊕:_ : {a b c : Obj} Arr b c Arr a b Arr a c
(g , g') :⊕: (f , f') = g f , g' f'
module _ {A B C D : Obj} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
:assoc: : (_:⊕:_ {A} {C} {D} h (_:⊕:_ {A} {B} {C} g f)) (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} h g) f)
:assoc: = {!!}
module _ {A B : Obj} {f : Arr A B} where
:ident: : (_:⊕:_ {A} {A} {B} f one) f × (_:⊕:_ {A} {B} {B} one f) f
:ident: = {!!}
instance
:isCategory: : IsCategory Obj Arr one (λ {a b c} _:⊕:_ {a} {b} {c})
:isCategory: = record
{ assoc = λ {A} {B} {C} {D} {f} {g} {h} :assoc: {A} {B} {C} {D} {f} {g} {h}
; ident = {!!}
}
Fam : Category (lsuc (a b)) (a b)
Fam = record
{ Object = Obj
; Arrow = Arr
; 𝟙 = one
; _⊕_ = λ {a b c} _:⊕:_ {a} {b} {c}
}
Contexts = .Object
Substitutions = .Arrow
record CwF : Set {!a ⊔ b!} where
field
Terms : Functor (Opposite ) Fam
module _ { ' : Level} (Ns : Set ) where
-- Ns is the "namespace"
o = (lsuc lzero )
FiniteDecidableSubset : Set
FiniteDecidableSubset = Ns Bool
isTrue : Bool Set
isTrue false =
isTrue true =
elmsof : (Ns Bool) Set
elmsof P = (σ : Ns) isTrue (P σ)
𝟚 : Set
𝟚 = Bool
module _ (I J : FiniteDecidableSubset) where
private
themap : Set {!!}
themap = elmsof I elmsof J 𝟚
rules : (elmsof I elmsof J 𝟚) Set
rules f = (i j : elmsof I) {!!}
Mor = Σ themap rules
-- The category of names and substitutions
: Category -- o (lsuc lzero ⊔ o)
= record
-- { Object = FiniteDecidableSubset
{ Object = Ns Bool
; Arrow = Mor
; 𝟙 = {!!}
; _⊕_ = {!!}
; isCategory = {!!}
}

55
src/Cat/CwF.agda Normal file
View file

@ -0,0 +1,55 @@
module Cat.CwF where
open import Agda.Primitive
open import Data.Product
open import Cat.Category
open import Cat.Functor
open import Cat.Categories.Fam
open Category
open Functor
module _ {a b : Level} where
record CwF : Set (lsuc (a b)) where
-- "A category with families consists of"
field
-- "A base category"
: Category a b
-- It's objects are called contexts
Contexts = .Object
-- It's arrows are called substitutions
Substitutions = .Arrow
field
-- A functor T
T : Functor (Opposite ) (Fam a b)
-- Empty context
[] : Terminal
Type : (Γ : .Object) Set a
Type Γ = proj₁ (T .func* Γ)
module _ {Γ : .Object} {A : Type Γ} where
module _ {A B : .Object} {γ : [ A , B ]} where
k : Σ (proj₁ (func* T B) proj₁ (func* T A))
(λ f
{x : proj₁ (func* T B)}
proj₂ (func* T B) x proj₂ (func* T A) (f x))
k = T .func→ γ
k₁ : proj₁ (func* T B) proj₁ (func* T A)
k₁ = proj₁ k
k₂ : ({x : proj₁ (func* T B)}
proj₂ (func* T B) x proj₂ (func* T A) (k₁ x))
k₂ = proj₂ k
record ContextComprehension : Set (a b) where
field
Γ&A : .Object
proj1 : .Arrow Γ&A Γ
-- proj2 : ????
-- if γ : [ A , B ]
-- then T .func→ γ (written T[γ]) interpret substitutions in types and terms respectively.
-- field
-- ump : {Δ : .Object} → (γ : [ Δ , Γ ])
-- → (a : {!!}) → {!!}

21
src/Cat/Equality.agda Normal file
View file

@ -0,0 +1,21 @@
-- Defines equality-principles for data-types from the standard library.
module Cat.Equality where
open import Level
open import Cubical
-- _[_≡_] = PathP
module Equality where
module Data where
module Product where
open import Data.Product
module _ {a b : Level} {A : Set a} {B : A Set b} {a b : Σ A B}
(proj₁≡ : (λ _ A) [ proj₁ a proj₁ b ])
(proj₂≡ : (λ i B (proj₁≡ i)) [ proj₂ a proj₂ b ]) where
Σ≡ : a b
proj₁ (Σ≡ i) = proj₁≡ i
proj₂ (Σ≡ i) = proj₂≡ i

View file

@ -6,36 +6,54 @@ open import Function
open import Cat.Category open import Cat.Category
record Functor {c c' d d'} (C : Category c c') (D : Category d d') open Category hiding (_∘_)
module _ {c c' d d'} ( : Category c c') (𝔻 : Category d d') where
record IsFunctor
(func* : Obj Obj 𝔻)
(func→ : {A B : Obj } [ A , B ] 𝔻 [ func* A , func* B ])
: Set (c c' d d') where : Set (c c' d d') where
open Category
field field
func* : C .Object D .Object ident : {c : Obj } func→ ( .𝟙 {c}) 𝔻 .𝟙 {func* c}
func→ : {dom cod : C .Object} C .Arrow dom cod D .Arrow (func* dom) (func* cod)
ident : { c : C .Object } func→ (C .𝟙 {c}) D .𝟙 {func* c}
-- TODO: Avoid use of ugly explicit arguments somehow. -- TODO: Avoid use of ugly explicit arguments somehow.
-- This guy managed to do it: -- This guy managed to do it:
-- https://github.com/copumpkin/categories/blob/master/Categories/Functor/Core.agda -- https://github.com/copumpkin/categories/blob/master/Categories/Functor/Core.agda
distrib : { c c' c'' : C .Object} {a : C .Arrow c c'} {a' : C .Arrow c' c''} distrib : {A B C : .Object} {f : [ A , B ]} {g : [ B , C ]}
func→ (C ._⊕_ a' a) D ._⊕_ (func→ a') (func→ a) func→ ( [ g f ]) 𝔻 [ func→ g func→ f ]
record Functor : Set (c c' d d') where
field
func* : .Object 𝔻 .Object
func→ : {A B} [ A , B ] 𝔻 [ func* A , func* B ]
{{isFunctor}} : IsFunctor func* func→
open IsFunctor
open Functor open Functor
open Category
module _ { ' : Level} { 𝔻 : Category '} where module _ { ' : Level} { 𝔻 : Category '} where
private
_⊕_ = ._⊕_ IsFunctor≡
: {func* : .Object 𝔻 .Object}
{func→ : {A B : .Object} .Arrow A B 𝔻 .Arrow (func* A) (func* B)}
{F G : IsFunctor 𝔻 func* func→}
(eqI
: (λ i {A} func→ ( .𝟙 {A}) 𝔻 .𝟙 {func* A})
[ F .ident G .ident ])
(eqD :
(λ i {A B C} {f : [ A , B ]} {g : [ B , C ]}
func→ ( [ g f ]) 𝔻 [ func→ g func→ f ])
[ F .distrib G .distrib ])
(λ _ IsFunctor 𝔻 (λ i func* i) func→) [ F G ]
IsFunctor≡ eqI eqD i = record { ident = eqI i ; distrib = eqD i }
Functor≡ : {F G : Functor 𝔻} Functor≡ : {F G : Functor 𝔻}
(eq* : F .func* G .func*) (eq* : F .func* G .func*)
(eq→ : PathP (λ i {x y} .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y)) (eq→ : (λ i {x y} [ x , y ] 𝔻 [ eq* i x , eq* i y ])
(F .func→) (G .func→)) [ F .func→ G .func→ ])
(eqI : PathP (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A}) -- → (eqIsF : PathP (λ i → IsFunctor 𝔻 (eq* i) (eq→ i)) (F .isFunctor) (G .isFunctor))
(ident F) (ident G)) (eqIsFunctor : (λ i IsFunctor 𝔻 (eq* i) (eq→ i)) [ F .isFunctor G .isFunctor ])
(eqD : PathP (λ i {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}
eq→ i ( ._⊕_ g f) 𝔻 ._⊕_ (eq→ i g) (eq→ i f))
(distrib F) (distrib G))
F G F G
Functor≡ eq* eq→ eqI eqD i = record { func* = eq* i ; func→ = eq→ i ; ident = eqI i ; distrib = eqD i } Functor≡ eq* eq→ eqIsFunctor i = record { func* = eq* i ; func→ = eq→ i ; isFunctor = eqIsFunctor i }
module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : Functor A B) where module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : Functor A B) where
private private
@ -43,36 +61,37 @@ module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : F
F→ = F .func→ F→ = F .func→
G* = G .func* G* = G .func*
G→ = G .func→ G→ = G .func→
_A⊕_ = A ._⊕_ module _ {a0 a1 a2 : A .Object} {α0 : A [ a0 , a1 ]} {α1 : A [ a1 , a2 ]} where
_B⊕_ = B ._⊕_
_C⊕_ = C ._⊕_
module _ {a0 a1 a2 : A .Object} {α0 : A .Arrow a0 a1} {α1 : A .Arrow a1 a2} where
dist : (F→ G→) (α1 A⊕ α0) (F→ G→) α1 C⊕ (F→ G→) α0 dist : (F→ G→) (A [ α1 α0 ]) C [ (F→ G→) α1 (F→ G→) α0 ]
dist = begin dist = begin
(F→ G→) (α1 A⊕ α0) ≡⟨ refl (F→ G→) (A [ α1 α0 ]) ≡⟨ refl
F→ (G→ (α1 A⊕ α0)) ≡⟨ cong F→ (G .distrib) F→ (G→ (A [ α1 α0 ])) ≡⟨ cong F→ (G .isFunctor .distrib)
F→ ((G→ α1) B⊕ (G→ α0)) ≡⟨ F .distrib F→ (B [ G→ α1 G→ α0 ]) ≡⟨ F .isFunctor .distrib
(F→ G→) α1 C⊕ (F→ G→) α0 C [ (F→ G→) α1 (F→ G→) α0 ]
_∘f_ : Functor A C _∘f_ : Functor A C
_∘f_ = _∘f_ =
record record
{ func* = F* G* { func* = F* G*
; func→ = F→ G→ ; func→ = F→ G→
; ident = begin ; isFunctor = record
{ ident = begin
(F→ G→) (A .𝟙) ≡⟨ refl (F→ G→) (A .𝟙) ≡⟨ refl
F→ (G→ (A .𝟙)) ≡⟨ cong F→ (G .ident) F→ (G→ (A .𝟙)) ≡⟨ cong F→ (G .isFunctor .ident)
F→ (B .𝟙) ≡⟨ F .ident F→ (B .𝟙) ≡⟨ F .isFunctor .ident
C .𝟙 C .𝟙
; distrib = dist ; distrib = dist
} }
}
-- The identity functor -- The identity functor
identity : { '} {C : Category '} Functor C C identity : { '} {C : Category '} Functor C C
identity = record identity = record
{ func* = λ x x { func* = λ x x
; func→ = λ x x ; func→ = λ x x
; ident = refl ; isFunctor = record
{ ident = refl
; distrib = refl ; distrib = refl
} }
}