Rename some variables

This commit is contained in:
Frederik Hanghøj Iversen 2018-01-25 12:44:47 +01:00
parent 7a77ba230c
commit 812662bda3
2 changed files with 72 additions and 59 deletions

View file

@ -27,6 +27,7 @@ open Category
module _ ( ' : Level) where
private
module _ {A B C D : Category '} {f : Functor A B} {g : Functor B C} {h : Functor C D} where
private
eq* : func* (h ∘f (g ∘f f)) func* ((h ∘f g) ∘f f)
eq* = refl
eq→ : PathP
@ -46,22 +47,42 @@ module _ ( ' : Level) where
assc : h ∘f (g ∘f f) (h ∘f g) ∘f f
assc = Functor≡ eq* eq→ eqI eqD
module _ {A B : Category '} {f : Functor A B} where
lem : (func* f) (func* (identity {C = A})) func* f
lem = 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
lemmm : PathP
eq→ : PathP
(λ i
{x y : Object A} Arrow A x y Arrow B (func* f x) (func* f y))
(func→ (f ∘f identity)) (func→ f)
lemmm = refl
postulate lemz : PathP (λ i {c : A .Object} PathP (λ _ Arrow B (func* f c) (func* f c)) (func→ f (A .𝟙)) (B .𝟙))
(ident (f ∘f identity)) (ident f)
-- lemz = {!!}
postulate ident-r : f ∘f identity f
-- ident-r = lift-eq-functors lem lemmm {!lemz!} {!!}
postulate ident-l : identity ∘f f f
-- ident-l = lift-eq-functors lem lemmm {!refl!} {!!}
{x y : Object } Arrow x y Arrow 𝔻 (func* F x) (func* F y))
(func→ (F ∘f identity)) (func→ F)
eq→ = refl
postulate
eqI-r : PathP (λ i {c : .Object}
PathP (λ _ Arrow 𝔻 (func* F c) (func* F c)) (func→ F ( .𝟙)) (𝔻 .𝟙))
(ident (F ∘f identity)) (ident F)
eqD-r : PathP
(λ i
{A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}
eq→ i ( ._⊕_ g f) 𝔻 ._⊕_ (eq→ i g) (eq→ i f))
((F ∘f identity) .distrib) (distrib F)
ident-r : F ∘f identity F
ident-r = Functor≡ eq* eq→ eqI-r eqD-r
module _ where
private
postulate
eq* : (identity ∘f F) .func* F .func*
eq→ : PathP
(λ i {x y : Object } .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y))
((identity ∘f F) .func→) (F .func→)
eqI : PathP (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A})
(ident (identity ∘f F)) (ident F)
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 (identity ∘f F)) (distrib F)
ident-l : identity ∘f F F
ident-l = Functor≡ eq* eq→ eqI eqD
Cat : Category (lsuc ( ')) ( ')
Cat =
@ -80,19 +101,19 @@ module _ ( ' : Level) where
module _ { ' : Level} where
Catt = Cat '
module _ (C D : Category ') where
module _ ( 𝔻 : Category ') where
private
:Object: = C .Object × D .Object
:Object: = .Object × 𝔻 .Object
:Arrow: : :Object: :Object: Set '
:Arrow: (c , d) (c' , d') = Arrow C c c' × Arrow D d d'
:Arrow: (c , d) (c' , d') = Arrow c c' × Arrow 𝔻 d d'
:𝟙: : {o : :Object:} :Arrow: o o
:𝟙: = C .𝟙 , D .𝟙
:𝟙: = .𝟙 , 𝔻 .𝟙
_:⊕:_ :
{a b c : :Object:}
:Arrow: b c
:Arrow: a b
:Arrow: a c
_:⊕:_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) (C ._⊕_) bc∈C ab∈C , D ._⊕_ bc∈D ab∈D}
_:⊕:_ = λ { (bc∈C , bc∈D) (ab∈C , ab∈D) ( ._⊕_) bc∈C ab∈C , 𝔻 ._⊕_ bc∈D ab∈D}
instance
:isCategory: : IsCategory :Object: :Arrow: :𝟙: _:⊕:_
@ -103,8 +124,8 @@ module _ { ' : Level} where
, eqpair (snd C.ident) (snd D.ident)
}
where
open module C = IsCategory (C .isCategory)
open module D = IsCategory (D .isCategory)
open module C = IsCategory ( .isCategory)
open module D = IsCategory (𝔻 .isCategory)
:product: : Category '
:product: = record
@ -114,13 +135,13 @@ module _ { ' : Level} where
; _⊕_ = _:⊕:_
}
proj₁ : Arrow Catt :product: C
proj₁ : Arrow Catt :product:
proj₁ = record { func* = fst ; func→ = fst ; ident = refl ; distrib = refl }
proj₂ : Arrow Catt :product: D
proj₂ : Arrow Catt :product: 𝔻
proj₂ = record { func* = snd ; func→ = snd ; ident = refl ; distrib = refl }
module _ {X : Object Catt} (x₁ : Arrow Catt X C) (x₂ : Arrow Catt X D) where
module _ {X : Object Catt} (x₁ : Arrow Catt X ) (x₂ : Arrow Catt X 𝔻) where
open Functor
-- ident' : {c : Object X} → ((func→ x₁) {dom = c} (𝟙 X) , (func→ x₂) {dom = c} (𝟙 X)) ≡ 𝟙 (catProduct C D)
@ -137,10 +158,10 @@ module _ { ' : Level} where
-- Need to "lift equality of functors"
-- If I want to do this like I do it for pairs it's gonna be a pain.
postulate isUniqL : (Catt proj₁) x x₁
-- isUniqL = lift-eq-functors refl refl {!!} {!!}
-- isUniqL = Functor≡ refl refl {!!} {!!}
postulate isUniqR : (Catt proj₂) x x₂
-- isUniqR = lift-eq-functors refl refl {!!} {!!}
-- isUniqR = Functor≡ refl refl {!!} {!!}
isUniq : (Catt proj₁) x x₁ × (Catt proj₂) x x₂
isUniq = isUniqL , isUniqR
@ -149,10 +170,10 @@ module _ { ' : Level} where
uniq = x , isUniq
instance
isProduct : IsProduct Catt proj₁ proj₂
isProduct : IsProduct (Cat ') proj₁ proj₂
isProduct = uniq
product : Product { = Catt} C D
product : Product { = (Cat ')} 𝔻
product = record
{ obj = :product:
; proj₁ = proj₁
@ -160,7 +181,6 @@ module _ { ' : Level} where
}
module _ { ' : Level} where
open Category
instance
hasProducts : HasProducts (Cat ')
hasProducts = record { product = product }
@ -169,9 +189,7 @@ module _ { ' : Level} where
module _ ( : Level) where
private
open Data.Product
open Category
open import Cat.Categories.Fun
open Functor
Cat : Category (lsuc ( )) ( )
Cat = Cat
@ -317,7 +335,6 @@ module _ ( : Level) where
catTranspose : ∃![ F~ ] (Cat ._⊕_ :eval: (parallelProduct F~ (Cat .𝟙 {o = })) F)
catTranspose = transpose , eq
-- :isExponential: : IsExponential Cat A B :obj: {!:eval:!}
:isExponential: : IsExponential Cat 𝔻 :obj: :eval:
:isExponential: = catTranspose

View file

@ -29,10 +29,6 @@ module _ { ' : Level} { 𝔻 : Category '} where
(eq* : F .func* G .func*)
(eq→ : PathP (λ i {x y} .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y))
(F .func→) (G .func→))
-- → (eq→ : Functor.func→ f ≡ {!!}) -- Functor.func→ g)
-- Use PathP
-- directly to show heterogeneous equalities by using previous
-- equalities (i.e. continuous paths) to create new continuous paths.
(eqI : PathP (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A})
(ident F) (ident G))
(eqD : PathP (λ i {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}