Formatting

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-21 13:25:24 +01:00
parent 890154a81d
commit cd3514c8cf

View file

@ -18,8 +18,6 @@ open import Cat.Category.NaturalTransformation
open import Cat.Equality open import Cat.Equality
open Equality.Data.Product open Equality.Data.Product
open Category using (Object ; 𝟙)
-- The category of categories -- The category of categories
module _ ( ' : Level) where module _ ( ' : Level) where
private private
@ -35,19 +33,18 @@ module _ ( ' : Level) where
ident-l = Functor≡ refl ident-l = Functor≡ refl
RawCat : RawCategory (lsuc ( ')) ( ') RawCat : RawCategory (lsuc ( ')) ( ')
RawCat = RawCategory.Object RawCat = Category '
record RawCategory.Arrow RawCat = Functor
{ Object = Category ' RawCategory.𝟙 RawCat = identity
; Arrow = Functor RawCategory._∘_ RawCat = F[_∘_]
; 𝟙 = identity
; _∘_ = F[_∘_]
}
private private
open RawCategory RawCat open RawCategory RawCat
isAssociative : IsAssociative isAssociative : IsAssociative
isAssociative {f = F} {G} {H} = assc {F = F} {G = G} {H = H} isAssociative {f = F} {G} {H} = assc {F = F} {G = G} {H = H}
ident : IsIdentity identity
ident = ident-l , ident-r isIdentity : IsIdentity identity
isIdentity = ident-l , ident-r
-- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors, -- NB! `ArrowsAreSets RawCat` is *not* provable. The type of functors,
-- however, form a groupoid! Therefore there is no (1-)category of -- however, form a groupoid! Therefore there is no (1-)category of
@ -72,11 +69,13 @@ module CatProduct { ' : Level} ( 𝔻 : Category ') where
module = Category module = Category
module 𝔻 = Category 𝔻 module 𝔻 = Category 𝔻
Obj = Object × Object 𝔻 module _ where
private
Obj = .Object × 𝔻.Object
Arr : Obj Obj Set ' Arr : Obj Obj Set '
Arr (c , d) (c' , d') = [ c , c' ] × 𝔻 [ d , d' ] Arr (c , d) (c' , d') = [ c , c' ] × 𝔻 [ d , d' ]
𝟙' : {o : Obj} Arr o o 𝟙 : {o : Obj} Arr o o
𝟙' = 𝟙 , 𝟙 𝔻 𝟙 = .𝟙 , 𝔻.𝟙
_∘_ : _∘_ :
{a b c : Obj} {a b c : Obj}
Arr b c Arr b c
@ -87,13 +86,14 @@ module CatProduct { ' : Level} ( 𝔻 : Category ') where
rawProduct : RawCategory ' rawProduct : RawCategory '
RawCategory.Object rawProduct = Obj RawCategory.Object rawProduct = Obj
RawCategory.Arrow rawProduct = Arr RawCategory.Arrow rawProduct = Arr
RawCategory.𝟙 rawProduct = 𝟙' RawCategory.𝟙 rawProduct = 𝟙
RawCategory._∘_ rawProduct = _∘_ RawCategory._∘_ rawProduct = _∘_
open RawCategory rawProduct open RawCategory rawProduct
arrowsAreSets : ArrowsAreSets arrowsAreSets : ArrowsAreSets
arrowsAreSets = setSig {sA = .arrowsAreSets} {sB = λ x 𝔻.arrowsAreSets} arrowsAreSets = setSig {sA = .arrowsAreSets} {sB = λ x 𝔻.arrowsAreSets}
isIdentity : IsIdentity 𝟙' isIdentity : IsIdentity 𝟙
isIdentity isIdentity
= Σ≡ (fst .isIdentity) (fst 𝔻.isIdentity) = Σ≡ (fst .isIdentity) (fst 𝔻.isIdentity)
, Σ≡ (snd .isIdentity) (snd 𝔻.isIdentity) , Σ≡ (snd .isIdentity) (snd 𝔻.isIdentity)
@ -189,102 +189,65 @@ module CatExponential { : Level} ( 𝔻 : Category ) where
Category = Category Category = Category
open Fun 𝔻 renaming (identity to idN) open Fun 𝔻 renaming (identity to idN)
omap : Functor 𝔻 × Object Object 𝔻 omap : Functor 𝔻 × .Object 𝔻.Object
omap (F , A) = Functor.omap F A omap (F , A) = Functor.omap F A
-- The exponential object -- The exponential object
object : Category object : Category
object = Fun object = Fun
module _ {dom cod : Functor 𝔻 × Object } where module _ {dom cod : Functor 𝔻 × .Object} where
open Σ dom renaming (proj₁ to F ; proj₂ to A)
open Σ cod renaming (proj₁ to G ; proj₂ to B)
private private
F : Functor 𝔻
F = proj₁ dom
A : Object
A = proj₂ dom
G : Functor 𝔻
G = proj₁ cod
B : Object
B = proj₂ cod
module F = Functor F module F = Functor F
module G = Functor G module G = Functor G
fmap : (pobj : NaturalTransformation F G × [ A , B ]) fmap : (pobj : NaturalTransformation F G × [ A , B ])
𝔻 [ F.omap A , G.omap B ] 𝔻 [ F.omap A , G.omap B ]
fmap ((θ , θNat) , f) = result fmap ((θ , θNat) , f) = 𝔻 [ θ B F.fmap f ]
where -- Alternatively:
θA : 𝔻 [ F.omap A , G.omap A ] --
θA = θ A -- fmap ((θ , θNat) , f) = 𝔻 [ G.fmap f ∘ θ A ]
θB : 𝔻 [ F.omap B , G.omap B ] --
θB = θ B -- Since they are equal by naturality of θ.
F→f : 𝔻 [ F.omap A , F.omap B ]
F→f = F.fmap f
G→f : 𝔻 [ G.omap A , G.omap B ]
G→f = G.fmap f
l : 𝔻 [ F.omap A , G.omap B ]
l = 𝔻 [ θB F.fmap f ]
r : 𝔻 [ F.omap A , G.omap B ]
r = 𝔻 [ G.fmap f θA ]
result : 𝔻 [ F.omap A , G.omap B ]
result = l
open CatProduct renaming (object to _⊗_) using () open CatProduct renaming (object to _⊗_) using ()
module _ {c : Functor 𝔻 × Object } where module _ {c : Functor 𝔻 × .Object} where
private open Σ c renaming (proj₁ to F ; proj₂ to C)
F : Functor 𝔻
F = proj₁ c
C : Object
C = proj₂ c
ident : fmap {c} {c} (NT.identity F , 𝟙 {A = proj₂ c}) 𝟙 𝔻 ident : fmap {c} {c} (NT.identity F , .𝟙 {A = proj₂ c}) 𝔻.𝟙
ident = begin ident = begin
fmap {c} {c} (𝟙 (object ) {c}) ≡⟨⟩ fmap {c} {c} (Category.𝟙 (object ) {c}) ≡⟨⟩
fmap {c} {c} (idN F , 𝟙 ) ≡⟨⟩ fmap {c} {c} (idN F , .𝟙) ≡⟨⟩
𝔻 [ identityTrans F C F.fmap (𝟙 )] ≡⟨⟩ 𝔻 [ identityTrans F C F.fmap .𝟙 ] ≡⟨⟩
𝔻 [ 𝟙 𝔻 F.fmap (𝟙 )] ≡⟨ 𝔻.leftIdentity 𝔻 [ 𝔻.𝟙 F.fmap .𝟙 ] ≡⟨ 𝔻.leftIdentity
F.fmap (𝟙 ) ≡⟨ F.isIdentity F.fmap .𝟙 ≡⟨ F.isIdentity
𝟙 𝔻 𝔻.𝟙
where where
module F = Functor F module F = Functor F
module _ {F×A G×B H×C : Functor 𝔻 × Object } where module _ {F×A G×B H×C : Functor 𝔻 × .Object} where
open Σ F×A renaming (proj₁ to F ; proj₂ to A)
open Σ G×B renaming (proj₁ to G ; proj₂ to B)
open Σ H×C renaming (proj₁ to H ; proj₂ to C)
private private
F = F×A .proj₁
A = F×A .proj₂
G = G×B .proj₁
B = G×B .proj₂
H = H×C .proj₁
C = H×C .proj₂
module F = Functor F module F = Functor F
module G = Functor G module G = Functor G
module H = Functor H module H = Functor H
module _ module _
-- NaturalTransformation F G × .Arrow A B
{θ×f : NaturalTransformation F G × [ A , B ]} {θ×f : NaturalTransformation F G × [ A , B ]}
{η×g : NaturalTransformation G H × [ B , C ]} where {η×g : NaturalTransformation G H × [ B , C ]} where
open Σ θ×f renaming (proj₁ to θNT ; proj₂ to f)
open Σ θNT renaming (proj₁ to θ ; proj₂ to θNat)
open Σ η×g renaming (proj₁ to ηNT ; proj₂ to g)
open Σ ηNT renaming (proj₁ to η ; proj₂ to ηNat)
private private
θ : Transformation F G
θ = proj₁ (proj₁ θ×f)
θNat : Natural F G θ
θNat = proj₂ (proj₁ θ×f)
f : [ A , B ]
f = proj₂ θ×f
η : Transformation G H
η = proj₁ (proj₁ η×g)
ηNat : Natural G H η
ηNat = proj₂ (proj₁ η×g)
g : [ B , C ]
g = proj₂ η×g
ηθNT : NaturalTransformation F H ηθNT : NaturalTransformation F H
ηθNT = Category._∘_ Fun {F} {G} {H} (η , ηNat) (θ , θNat) ηθNT = NT[_∘_] {F} {G} {H} ηNT θNT
open Σ ηθNT renaming (proj₁ to ηθ ; proj₂ to ηθNat)
ηθ = proj₁ ηθNT
ηθNat = proj₂ ηθNT
isDistributive : isDistributive :
𝔻 [ 𝔻 [ η C θ C ] F.fmap ( [ g f ] ) ] 𝔻 [ 𝔻 [ η C θ C ] F.fmap ( [ g f ] ) ]