Add some stuff about the category of cubes

Also some feedback from Thierry
This commit is contained in:
Frederik Hanghøj Iversen 2018-02-02 14:47:33 +01:00
parent 6bb8ba3927
commit 19987dd917
8 changed files with 184 additions and 75 deletions

View file

@ -1,8 +1,8 @@
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
@ -11,3 +11,4 @@ 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

@ -0,0 +1,77 @@
{-# 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 hiding (Hom)
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
: Category -- o (lsuc lzero ⊔ o)
= record
{ Object = FiniteDecidableSubset
-- { Object = Ns → Bool
; Arrow = Hom
; 𝟙 = λ { {o} inj₁ , λ { (i , ii) (j , jj) eq Σ≡ eq {!refl!} } }
; _∘_ = {!!}
; isCategory = {!!}
}

View file

@ -11,7 +11,7 @@ open import Cat.Equality
open Equality.Data.Product open Equality.Data.Product
module _ {a b : Level} where module _ (a b : Level) where
private private
Obj = Σ[ A Set a ] (A Set b) Obj = Σ[ A Set a ] (A Set b)
Arr : Obj Obj Set (a b) Arr : Obj Obj Set (a b)

View file

@ -76,6 +76,7 @@ module _ {c c' d d' : Level} { : Category c c'} {𝔻 : Cat
𝔻 [ H .func→ f (θ ∘nt η) A ] 𝔻 [ H .func→ f (θ ∘nt η) A ]
where where
open IsCategory (𝔻 .isCategory) open IsCategory (𝔻 .isCategory)
NatComp = _:⊕:_ NatComp = _:⊕:_
private private

View file

@ -22,6 +22,7 @@ open import Cubical
syntax ∃!-syntax (λ x B) = ∃![ x ] B syntax ∃!-syntax (λ x B) = ∃![ x ] B
-- All projections must be `isProp`'s
record IsCategory { ' : Level} record IsCategory { ' : Level}
(Object : Set ) (Object : Set )
(Arrow : Object Object Set ') (Arrow : Object Object Set ')
@ -40,7 +41,11 @@ record Category ( ' : Level) : Set (lsuc (' ⊔ )) where
-- adding no-eta-equality can speed up type-checking. -- adding no-eta-equality can speed up type-checking.
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
@ -59,6 +64,8 @@ _[_,_] = Arrow
_[_∘_] : { '} ( : Category ') {A B C : .Object} (g : [ B , C ]) (f : [ A , B ]) [ A , C ] _[_∘_] : { '} ( : Category ') {A B C : .Object} (g : [ B , C ]) (f : [ A , B ]) [ A , C ]
_[_∘_] = _∘_ _[_∘_] = _∘_
module _ { ' : Level} { : Category '} where module _ { ' : Level} { : Category '} where
module _ { A B : .Object } where module _ { A B : .Object } where
Isomorphism : (f : .Arrow A B) Set ' Isomorphism : (f : .Arrow A B) Set '
@ -180,3 +187,19 @@ record CartesianClosed { ' : Level} ( : Category ') : Set (
field field
{{hasProducts}} : HasProducts {{hasProducts}} : HasProducts
{{hasExponentials}} : HasExponentials {{hasExponentials}} : HasExponentials
module _ {a b : Level} ( : Category a b) where
unique = isContr
IsInitial : .Object Set (a b)
IsInitial I = {X : .Object} unique ( .Arrow I X)
IsTerminal : .Object Set (a b)
-- ∃![ ? ] ?
IsTerminal T = {X : .Object} unique ( .Arrow X T)
Initial : Set (a b)
Initial = Σ ( .Object) IsInitial
Terminal : Set (a b)
Terminal = Σ ( .Object) IsTerminal

View file

@ -49,9 +49,14 @@ 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 Functor
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.Cat using (Cat)
open import Cat.Categories.Fun open import Cat.Categories.Fun
open import Cat.Categories.Sets open import Cat.Categories.Sets
@ -82,7 +87,23 @@ module _ { : Level} { : Category } where
eqNat : (λ i Natural (prshf c) (prshf c) (eqTrans i)) eqNat : (λ i Natural (prshf c) (prshf c) (eqTrans i))
[(λ _ funExt (λ _ .assoc)) identityNatural (prshf c)] [(λ _ funExt (λ _ .assoc)) identityNatural (prshf c)]
eqNat = {!!} 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] → -- eqNat = λ {A} {B} i [B,A] i' [A,c] →
-- let -- let
-- k : [ {!!} , {!!} ] -- k : [ {!!} , {!!} ]

View file

@ -1,69 +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 Function
open import Cubical
open import Cat.Category
open import Cat.Functor
open import Cat.Categories.Fam
-- 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 CwF { ' : Level} ( : Category ') where
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 : {!!}) → {!!}