Use alternate syntax for arrow-composition

This commit is contained in:
Frederik Hanghøj Iversen 2018-01-30 18:26:11 +01:00
parent c87a6fb469
commit e33911ad9e
2 changed files with 20 additions and 19 deletions

View file

@ -53,6 +53,12 @@ record Category ( ' : Level) : Set (lsuc (' ⊔ )) where
open Category
_[_,_] : { '} ( : Category ') (A : .Object) (B : .Object) Set '
_[_,_] = Arrow
_[_∘_] : { '} ( : Category ') {A B C : .Object} (g : [ B , C ]) (f : [ A , B ]) [ A , C ]
_[_∘_] = _⊕_
module _ { ' : Level} { : Category '} where
module _ { A B : .Object } where
Isomorphism : (f : .Arrow A B) Set '

View file

@ -11,28 +11,26 @@ open Category
module _ {c c' d d'} ( : Category c c') (𝔻 : Category d d') where
record IsFunctor
(func* : .Object 𝔻 .Object)
(func→ : {A B : .Object} .Arrow A B 𝔻 .Arrow (func* A) (func* B))
(func→ : {A B : .Object} [ A , B ] 𝔻 [ func* A , func* B ])
: Set (c c' d d') where
field
ident : { c : .Object } func→ ( .𝟙 {c}) 𝔻 .𝟙 {func* c}
-- TODO: Avoid use of ugly explicit arguments somehow.
-- This guy managed to do it:
-- https://github.com/copumpkin/categories/blob/master/Categories/Functor/Core.agda
distrib : {A B C : .Object} {f : .Arrow A B} {g : .Arrow B C}
func→ ( ._⊕_ g f) 𝔻 ._⊕_ (func→ g) (func→ f)
distrib : {A B C : .Object} {f : [ A , B ]} {g : [ B , C ]}
func→ ( [ g f ]) 𝔻 [ func→ g func→ f ]
record Functor : Set (c c' d d') where
field
func* : .Object 𝔻 .Object
func→ : {A B : .Object} .Arrow A B 𝔻 .Arrow (func* A) (func* B)
func→ : {A B} [ A , B ] 𝔻 [ func* A , func* B ]
{{isFunctor}} : IsFunctor func* func→
open IsFunctor
open Functor
module _ { ' : Level} { 𝔻 : Category '} where
private
_⊕_ = ._⊕_
-- IsFunctor≡ : ∀ {A B : .Object} {func* : .Object → 𝔻 .Object} {func→ : {A B : .Object} → .Arrow A B → 𝔻 .Arrow (func* A) (func* B)} {F G : IsFunctor 𝔻 func* func→}
-- → (eqI : PathP (λ i → ∀ {A : .Object} → func→ ( .𝟙 {A}) ≡ 𝔻 .𝟙 {func* A})
@ -45,13 +43,13 @@ module _ { ' : Level} { 𝔻 : Category '} where
Functor≡ : {F G : Functor 𝔻}
(eq* : F .func* G .func*)
(eq→ : PathP (λ i {x y} .Arrow x y 𝔻 .Arrow (eq* i x) (eq* i y))
(eq→ : PathP (λ i {x y} [ x , y ] 𝔻 [ eq* i x , eq* i y ])
(F .func→) (G .func→))
-- → (eqIsF : PathP (λ i → IsFunctor 𝔻 (eq* i) (eq→ i)) (F .isFunctor) (G .isFunctor))
(eqI : PathP (λ i {A : .Object} eq→ i ( .𝟙 {A}) 𝔻 .𝟙 {eq* i A})
(F .isFunctor .ident) (G .isFunctor .ident))
(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))
(eqD : PathP (λ i {A B C : .Object} {f : [ A , B ]} {g : [ B , C ]}
eq→ i ( [ g f ]) 𝔻 [ eq→ i g eq→ i f ])
(F .isFunctor .distrib) (G .isFunctor .distrib))
F G
Functor≡ eq* eq→ eqI eqD i = record { func* = eq* i ; func→ = eq→ i ; isFunctor = record { ident = eqI i ; distrib = eqD i } }
@ -62,17 +60,14 @@ module _ { ' : Level} {A B C : Category '} (F : Functor B C) (G : F
F→ = F .func→
G* = G .func*
G→ = G .func→
_A⊕_ = A ._⊕_
_B⊕_ = B ._⊕_
_C⊕_ = C ._⊕_
module _ {a0 a1 a2 : A .Object} {α0 : A .Arrow a0 a1} {α1 : A .Arrow a1 a2} where
module _ {a0 a1 a2 : A .Object} {α0 : A [ a0 , a1 ]} {α1 : A [ 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
(F→ G→) (α1 A⊕ α0) ≡⟨ refl
F→ (G→ (α1 A⊕ α0)) ≡⟨ cong F→ (G .isFunctor .distrib)
F→ ((G→ α1) B⊕ (G→ α0)) ≡⟨ F .isFunctor .distrib
(F→ G→) α1 C⊕ (F→ G→) α0
(F→ G→) (A [ α1 α0 ]) ≡⟨ refl
F→ (G→ (A [ α1 α0 ])) ≡⟨ cong F→ (G .isFunctor .distrib)
F→ (B [ G→ α1 G→ α0 ]) ≡⟨ F .isFunctor .distrib
C [ (F→ G→) α1 (F→ G→) α0 ]
_∘f_ : Functor A C
_∘f_ =