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

Clean up some stuff

Browse source
This commit is contained in:
Frederik Hanghøj Iversen 2018-01-25 12:01:37 +01:00
parent c5a3673d9b
commit a480fca956
4 changed files with 107 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -22,6 +22,7 @@ eqpair eqa eqb i = eqa i , eqb i
open Functor
open Category
module _ {ℓ ℓ' : Level} {A B : Category ℓ ℓ'} where
lift-eq-functors : {f g : Functor A B}
→ (eq* : f .func* ≡ g .func*)
@ -179,21 +180,24 @@ module _ {ℓ ℓ' : Level} where
module _ {ℓ ℓ' : Level} where
open Category
instance
CatHasProducts : HasProducts (Cat ℓ ℓ')
CatHasProducts = record { product = product }
hasProducts : HasProducts (Cat ℓ ℓ')
hasProducts = record { product = product }
-- Basically proves that `Cat ℓ ℓ` is cartesian closed.
module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)}} where
open Data.Product
open Category
module _ (ℓ : Level) where
private
Catℓ : Category (lsuc (ℓ ⊔ ℓ)) (ℓ ⊔ ℓ)
Catℓ = Cat ℓ ℓ
open Data.Product
open Category
open import Cat.Categories.Fun
open Functor
Catℓ : Category (lsuc (ℓ ⊔ ℓ)) (ℓ ⊔ ℓ)
Catℓ = Cat ℓ ℓ
module _ (ℂ 𝔻 : Category ℓ ℓ) where
private
_𝔻⊕_ = 𝔻 ._⊕_
_ℂ⊕_ = ℂ ._⊕_
:obj: : Cat ℓ ℓ .Object
:obj: = Fun {ℂ = ℂ} {𝔻 = 𝔻}
@ -216,7 +220,6 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)
→ 𝔻 .Arrow (F .func* A) (G .func* B)
:func→: ((θ , θNat) , f) = result
where
_𝔻⊕_ = 𝔻 ._⊕_
θA : 𝔻 .Arrow (F .func* A) (G .func* A)
θA = θ A
θB : 𝔻 .Arrow (F .func* B) (G .func* B)
@ -247,23 +250,22 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)
C = proj₂ c
-- NaturalTransformation F G × ℂ .Arrow A B
:ident: : :func→: {c} {c} (identityNat F , ℂ .𝟙) ≡ 𝔻 .𝟙
:ident: = trans (proj₂ 𝔻.ident) (F .ident)
where
_𝔻⊕_ = 𝔻 ._⊕_
open module 𝔻 = IsCategory (𝔻 .isCategory)
-- Unfortunately the equational version has some ambigous arguments.
-- :ident: : :func→: (identityNat F , ℂ .𝟙 {o = proj₂ c}) ≡ 𝔻 .𝟙
-- :ident: = begin
-- :func→: ((:obj: ×p ℂ) .Product.obj .𝟙) ≡⟨⟩
-- :func→: (identityNat F , ℂ .𝟙) ≡⟨⟩
-- (identityTrans F C 𝔻⊕ F .func→ (ℂ .𝟙)) ≡⟨⟩
-- (𝔻 .𝟙 𝔻⊕ F .func→ (ℂ .𝟙)) ≡⟨ proj₂ 𝔻.ident ⟩
-- F .func→ (ℂ .𝟙) ≡⟨ F .ident ⟩
-- 𝔻 .𝟙 ∎
-- :ident: : :func→: {c} {c} (identityNat F , ℂ .𝟙) ≡ 𝔻 .𝟙
-- :ident: = trans (proj₂ 𝔻.ident) (F .ident)
-- where
-- _𝔻⊕_ = 𝔻 ._⊕_
-- open module 𝔻 = IsCategory (𝔻 .isCategory)
-- Unfortunately the equational version has some ambigous arguments.
:ident: : :func→: {c} {c} (identityNat F , ℂ .𝟙 {o = proj₂ c}) ≡ 𝔻 .𝟙
:ident: = begin
:func→: {c} {c} ((:obj: ×p ℂ) .Product.obj .𝟙 {c}) ≡⟨⟩
:func→: {c} {c} (identityNat F , ℂ .𝟙) ≡⟨⟩
(identityTrans F C 𝔻⊕ F .func→ (ℂ .𝟙)) ≡⟨⟩
𝔻 .𝟙 𝔻⊕ F .func→ (ℂ .𝟙) ≡⟨ proj₂ 𝔻.ident ⟩
F .func→ (ℂ .𝟙) ≡⟨ F .ident ⟩
𝔻 .𝟙 ∎
where
open module 𝔻 = IsCategory (𝔻 .isCategory)
module _ {F×A G×B H×C : Functor ℂ 𝔻 × ℂ .Object} where
F = F×A .proj₁
A = F×A .proj₂
@ -271,68 +273,50 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)
B = G×B .proj₂
H = H×C .proj₁
C = H×C .proj₂
_𝔻⊕_ = 𝔻 ._⊕_
_ℂ⊕_ = ℂ ._⊕_
-- Not entirely clear what this is at this point:
_P⊕_ = (:obj: ×p ℂ) .Product.obj ._⊕_ {F×A} {G×B} {H×C}
module _
-- NaturalTransformation F G × ℂ .Arrow A B
{θ×α : NaturalTransformation F G × ℂ .Arrow A B}
{η×β : NaturalTransformation G H × ℂ .Arrow B C} where
θ : Transformation F G
θ = proj₁ (proj₁ θ×α)
θNat : Natural F G θ
θNat = proj₂ (proj₁ θ×α)
f : ℂ .Arrow A B
f = proj₂ θ×α
η : Transformation G H
η = proj₁ (proj₁ η×β)
ηNat : Natural G H η
ηNat = proj₂ (proj₁ η×β)
g : ℂ .Arrow B C
g = proj₂ η×β
-- :func→: ((θ , θNat) , f) = θB 𝔻⊕ F→f
_ : (:func→: {F×A} {G×B} θ×α) ≡ (θ B 𝔻⊕ F .func→ f)
_ = refl
ηθ : NaturalTransformation F H
ηθ = Fun ._⊕_ {F} {G} {H} (η , ηNat) (θ , θNat)
_ : ηθ ≡ Fun ._⊕_ {F} {G} {H} (η , ηNat) (θ , θNat)
_ = refl
ηθT = proj₁ ηθ
ηθN = proj₂ ηθ
_ : ηθT ≡ λ T → η T 𝔻⊕ θ T -- Fun ._⊕_ {F} {G} {H} (η , ηNat) (θ , θNat)
_ = refl
{θ×f : NaturalTransformation F G × ℂ .Arrow A B}
{η×g : NaturalTransformation G H × ℂ .Arrow B C} where
private
θ : Transformation F G
θ = proj₁ (proj₁ θ×f)
θNat : Natural F G θ
θNat = proj₂ (proj₁ θ×f)
f : ℂ .Arrow A B
f = proj₂ θ×f
η : Transformation G H
η = proj₁ (proj₁ η×g)
ηNat : Natural G H η
ηNat = proj₂ (proj₁ η×g)
g : ℂ .Arrow B C
g = proj₂ η×g
ηθNT : NaturalTransformation F H
ηθNT = Fun ._⊕_ {F} {G} {H} (η , ηNat) (θ , θNat)
ηθ = proj₁ ηθNT
ηθNat = proj₂ ηθNT
:distrib: :
:func→: {F×A} {H×C} (η×β P⊕ θ×α)
≡ (:func→: {G×B} {H×C} η×β) 𝔻⊕ (:func→: {F×A} {G×B} θ×α)
(η C 𝔻⊕ θ C) 𝔻⊕ F .func→ (g ℂ⊕ f)
≡ (η C 𝔻⊕ G .func→ g) 𝔻⊕ (θ B 𝔻⊕ F .func→ f)
:distrib: = begin
:func→: {F×A} {H×C} (η×β P⊕ θ×α) ≡⟨⟩
:func→: {F×A} {H×C} (ηθ , g ℂ⊕ f) ≡⟨⟩
(ηθT C 𝔻⊕ F .func→ (g ℂ⊕ f)) ≡⟨ ηθN (g ℂ⊕ f) ⟩
(H .func→ (g ℂ⊕ f) 𝔻⊕ ηθT A) ≡⟨ cong (λ φ → φ 𝔻⊕ ηθT A) (H .distrib) ⟩
((H .func→ g 𝔻⊕ H .func→ f) 𝔻⊕ ηθT A) ≡⟨ sym 𝔻.assoc ⟩
(H .func→ g 𝔻⊕ (H .func→ f 𝔻⊕ ηθT A)) ≡⟨⟩
(H .func→ g 𝔻⊕ (H .func→ f 𝔻⊕ (η A 𝔻⊕ θ 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→: {G×B} {H×C} η×β) 𝔻⊕ (:func→: {F×A} {G×B} θ×α)) ∎
(ηθ C) 𝔻⊕ F .func→ (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)) ≡⟨⟩
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) ∎
where
lemθ : θ B 𝔻⊕ F .func→ f ≡ G .func→ f 𝔻⊕ θ A
lemθ = θNat f
lemη : η C 𝔻⊕ G .func→ g ≡ H .func→ g 𝔻⊕ η B
lemη = ηNat g
lemm : ηθT C 𝔻⊕ F .func→ (g ℂ⊕ f) ≡ (H .func→ (g ℂ⊕ f) 𝔻⊕ ηθT A)
lemm = ηθN (g ℂ⊕ f)
final : η B 𝔻⊕ G .func→ f ≡ H .func→ f 𝔻⊕ η A
final = ηNat f
open module 𝔻 = IsCategory (𝔻 .isCategory)
-- Type of `:eval:` is aka.:
-- Functor ((:obj: ×p ℂ) .Product.obj) 𝔻
-- :eval: : Cat ℓ ℓ .Arrow ((:obj: ×p ℂ) .Product.obj) 𝔻
open IsCategory (𝔻 .isCategory)
:eval: : Functor ((:obj: ×p ℂ) .Product.obj) 𝔻
:eval: = record
{ func* = :func*:
@ -342,14 +326,8 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)
}
module _ (𝔸 : Category ℓ ℓ) (F : Functor ((𝔸 ×p ℂ) .Product.obj) 𝔻) where
instance
CatℓHasProducts : HasProducts Catℓ
CatℓHasProducts = CatHasProducts {ℓ} {ℓ}
t : Catℓ .Arrow ((𝔸 ×p ℂ) .Product.obj) 𝔻 ≡ Functor ((𝔸 ×p ℂ) .Product.obj) 𝔻
t = refl
tt : Category ℓ ℓ
tt = (𝔸 ×p ℂ) .Product.obj
open HasProducts CatℓHasProducts
open HasProducts (hasProducts {ℓ} {ℓ}) using (parallelProduct)
postulate
transpose : Functor 𝔸 :obj:
eq : Catℓ ._⊕_ :eval: (parallelProduct transpose (Catℓ .𝟙 {o = ℂ})) ≡ F
@ -369,5 +347,5 @@ module _ {ℓ : Level} {ℂ : Category ℓ ℓ} {{_ : HasProducts (Opposite ℂ)
; isExponential = :isExponential:
}
CatHasExponentials : HasExponentials Catℓ
CatHasExponentials = record { exponent = :exponent: }
hasExponentials : HasExponentials (Cat ℓ ℓ)
hasExponentials = record { exponent = :exponent: }

16
src/Cat/Categories/Sets.agda
View file

@ -1,5 +1,3 @@
{-# OPTIONS --allow-unsolved-metas #-}
module Cat.Categories.Sets where
open import Cubical.PathPrelude
@ -25,17 +23,19 @@ module _ {ℓ : Level} where
private
module _ {X A B : Set ℓ} (f : X → A) (g : X → B) where
pair : (X → A × B)
pair x = f x , g x
lem : Sets ._⊕_ proj₁ pair ≡ f × Sets ._⊕_ snd pair ≡ g
_&&&_ : (X → A × B)
_&&&_ x = f x , g x
module _ {X A B : Set ℓ} (f : X → A) (g : X → B) where
_S⊕_ = Sets ._⊕_
lem : proj₁ S⊕ (f &&& g) ≡ f × snd S⊕ (f &&& g) ≡ g
proj₁ lem = refl
snd lem = refl
proj₂ lem = refl
instance
isProduct : {A B : Sets .Object} → IsProduct Sets {A} {B} fst snd
isProduct f g = pair 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 = record { obj = A × B ; proj₁ = fst ; proj₂ = snd ; isProduct = {!!} }
product A B = record { obj = A × B ; proj₁ = fst ; proj₂ = snd ; isProduct = isProduct }
instance
SetsHasProducts : HasProducts Sets

8
src/Cat/Category.agda
View file

@ -141,8 +141,8 @@ module _ {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} where
→ Hom ℂ A B → Hom ℂ A B'
HomFromArrow _A = _⊕_ ℂ
module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{ℂHasProducts : HasProducts ℂ}} where
open HasProducts ℂHasProducts
module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where
open HasProducts hasProducts
open Product hiding (obj)
private
_×p_ : (A B : ℂ .Object) → ℂ .Object
@ -161,8 +161,8 @@ module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{ℂHasProducts : HasProducts ℂ
{{isExponential}} : IsExponential obj eval
-- If I make this an instance-argument then the instance resolution
-- algorithm goes into an infinite loop. Why?
productsFromExp : HasProducts ℂ
productsFromExp = ℂHasProducts
exponentialsHaveProducts : HasProducts ℂ
exponentialsHaveProducts = hasProducts
transpose : (A : ℂ .Object) → ℂ .Arrow (A ×p B) C → ℂ .Arrow A obj
transpose A f = fst (isExponential A f)

46
src/Cat/Category/Properties.agda
View file

@ -48,25 +48,37 @@ epi-mono-is-not-iso f =
in {!!}
-}
open import Cat.Categories.Cat
module _ {ℓ : Level} {ℂ : Category ℓ ℓ} where
open import Cat.Category
open Category
open import Cat.Categories.Cat using (Cat)
module Cat = Cat.Categories.Cat
open Exponential
open HasExponentials CatHasExponentials
private
Catℓ = Cat ℓ ℓ
CatHasExponentials : HasExponentials Catℓ
CatHasExponentials = Cat.hasExponentials ℓ
Exp : Set {!!}
Exp = Exponential (Cat {!!} {!!}) {{ℂHasProducts = {!!}}}
Sets (Opposite {!!})
-- Exp : Set (lsuc (lsuc ℓ))
-- Exp = Exponential (Cat (lsuc ℓ) ℓ)
-- Sets (Opposite ℂ)
-- _⇑_ : (A B : Catℓ .Object) → Catℓ .Object
-- A ⇑ B = (exponent A B) .obj
_⇑_ : (A B : Catℓ .Object) → Catℓ .Object
A ⇑ B = (exponent A B) .obj
where
open HasExponentials CatHasExponentials
-- private
-- :func*: : ℂ .Object → (Sets ⇑ Opposite ℂ) .Object
-- :func*: x = {!!}
private
-- I need `Sets` to be a `Category ℓ ℓ` but it simlpy isn't.
Setz : Category ℓ ℓ
Setz = {!Sets!}
:func*: : ℂ .Object → (Setz ⇑ Opposite ℂ) .Object
:func*: A = {!!}
-- yoneda : Functor ℂ (Sets ⇑ (Opposite ℂ))
-- yoneda = record
-- { func* = :func*:
-- ; func→ = {!!}
-- ; ident = {!!}
-- ; distrib = {!!}
-- }
yoneda : Functor ℂ (Setz ⇑ (Opposite ℂ))
yoneda = record
{ func* = :func*:
; func→ = {!!}
; ident = {!!}
; distrib = {!!}
}