├── .gitignore ├── README.org ├── cubical-categories.agda-lib └── src └── Categories ├── Category.agda ├── Category ├── Core.agda ├── Instances │ ├── Cat.agda │ └── Path.agda ├── Op.agda ├── Product.agda └── Properties │ └── Core.agda ├── CommutativeDiagram └── Square.agda ├── Functor ├── Core.agda └── Properties │ └── Core.agda ├── Monad └── Core.agda ├── NaturalTransformation └── Core.agda ├── Reasoning ├── Commutative.agda └── Hom.agda └── Setoid.agda /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE:Cubical Categories 2 | 3 | This library formalizes Category Theory inside of Cubical Agda. 4 | This lets us avoid issues of morphism equality, and hopefully 5 | lets us implement things like strict categories is a much easier way. 6 | 7 | * Origins 8 | This library was born out of https://github.com/agda/agda-categories, and takes 9 | quite a bit of inspiration from it. 10 | -------------------------------------------------------------------------------- /cubical-categories.agda-lib: -------------------------------------------------------------------------------- 1 | depend: cubical 2 | standard-library 3 | include: src -------------------------------------------------------------------------------- /src/Categories/Category.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Category where 3 | 4 | open import Categories.Category.Core public 5 | 6 | infix 10 _[_,_] _[_∘_] 7 | 8 | _[_,_] : ∀ {o ℓ} → (C : Category o ℓ) → (X : Category.Obj C) → (Y : Category.Obj C) → Set ℓ 9 | _[_,_] = Category._⇒_ 10 | 11 | _[_∘_] : ∀ {o ℓ} → (C : Category o ℓ) → ∀ {X Y Z} (f : C [ Y , Z ]) → (g : C [ X , Y ]) → C [ X , Z ] 12 | _[_∘_] = Category._∘_ 13 | 14 | -------------------------------------------------------------------------------- /src/Categories/Category/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Category.Core where 3 | 4 | open import Level 5 | 6 | open import Relation.Binary hiding (_⇒_) 7 | 8 | open import Data.Unit.Polymorphic using (⊤; tt) 9 | 10 | open import Cubical.Foundations.Prelude 11 | 12 | record Category (o ℓ : Level) : Set (suc (o ⊔ ℓ)) where 13 | eta-equality 14 | infix 4 _⇒_ 15 | infixr 9 _∘_ 16 | 17 | field 18 | Obj : Set o 19 | _⇒_ : Rel Obj ℓ 20 | 21 | id : ∀ {A} → (A ⇒ A) 22 | _∘_ : ∀ {A B C} → (B ⇒ C) → (A ⇒ B) → (A ⇒ C) 23 | 24 | field 25 | assoc : ∀ {A B C D} {f : A ⇒ B} {g : B ⇒ C} {h : C ⇒ D} → (h ∘ g) ∘ f ≡ h ∘ (g ∘ f) 26 | identityˡ : ∀ {A B} {f : A ⇒ B} → id ∘ f ≡ f 27 | identityʳ : ∀ {A B} {f : A ⇒ B} → f ∘ id ≡ f 28 | 29 | ∘-congˡ : ∀ {A B C} {f : A ⇒ B} {f′ : A ⇒ B} {g : B ⇒ C} → f ≡ f′ → g ∘ f ≡ g ∘ f′ 30 | ∘-congˡ {g = g} f≡f′ = cong (λ k → g ∘ k) f≡f′ 31 | 32 | ∘-congʳ : ∀ {A B C} {f : B ⇒ C} {f′ : B ⇒ C} {g : A ⇒ B} → f ≡ f′ → f ∘ g ≡ f′ ∘ g 33 | ∘-congʳ {g = g} f≡f′ = cong (λ k → k ∘ g) f≡f′ 34 | 35 | 36 | -- A single object category 37 | One : ∀ {o ℓ} → Category o ℓ 38 | One {o} {ℓ} = record 39 | { Obj = ⊤ o 40 | ; _⇒_ = λ _ _ → ⊤ ℓ 41 | ; id = tt 42 | ; _∘_ = λ _ _ → tt 43 | ; assoc = λ i → tt 44 | ; identityˡ = λ i → tt 45 | ; identityʳ = λ i → tt 46 | } 47 | 48 | -- The category of sets 49 | SET : ∀ o → Category (suc o) o 50 | SET o = record 51 | { Obj = Set o 52 | ; _⇒_ = λ a b → a → b 53 | ; id = λ x → x 54 | ; _∘_ = λ f g x → f (g x) 55 | ; assoc = refl 56 | ; identityˡ = refl 57 | ; identityʳ = refl 58 | } 59 | 60 | 61 | _ᵒᵖ : ∀ {o ℓ} → Category o ℓ → Category o ℓ 62 | C ᵒᵖ = record 63 | { Obj = C.Obj 64 | ; _⇒_ = λ a b → b ⇒ a 65 | ; id = C.id 66 | ; _∘_ = λ f g → g ∘ f 67 | ; assoc = sym C.assoc 68 | ; identityˡ = C.identityʳ 69 | ; identityʳ = C.identityˡ 70 | } 71 | where 72 | module C = Category C 73 | open C 74 | -------------------------------------------------------------------------------- /src/Categories/Category/Instances/Cat.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Category.Instances.Cat where 3 | 4 | open import Level 5 | 6 | open import Categories.Category.Core 7 | open import Categories.Functor.Core renaming (id to Id) 8 | open import Categories.Functor.Properties.Core 9 | 10 | CAT : ∀ (o ℓ : Level) → Category (suc (o ⊔ ℓ)) (o ⊔ ℓ) 11 | CAT o ℓ = record 12 | { Obj = Category o ℓ 13 | ; _⇒_ = λ 𝓒 𝓓 → Functor 𝓒 𝓓 14 | ; id = Id 15 | ; _∘_ = _∘F_ 16 | ; assoc = λ {_ _ _ _ F G H} i → ∘F-assoc F G H i 17 | ; identityˡ = λ {_ _ F} i → ∘F-identityˡ F i 18 | ; identityʳ = λ {_ _ F} i → ∘F-identityʳ F i 19 | } 20 | -------------------------------------------------------------------------------- /src/Categories/Category/Instances/Path.agda: -------------------------------------------------------------------------------- 1 | 2 | {-# OPTIONS --cubical --safe #-} 3 | module Categories.Category.Instances.Path where 4 | 5 | open import Level 6 | 7 | open import Cubical.Foundations.Prelude 8 | open import Cubical.Foundations.GroupoidLaws renaming 9 | ( lUnit to ∙-identityˡ 10 | ; rUnit to ∙-identityʳ 11 | ; assoc to ∙-assoc 12 | ) 13 | 14 | open import Categories.Category.Core 15 | open import Categories.Functor.Core 16 | 17 | private 18 | variable 19 | o : Level 20 | A B : Set o 21 | 22 | {- 23 | Unfortunately, `cubical` defines composition 24 | of paths with it's arguments flipped, so we 25 | have to do some munging to get everything to line up. 26 | -} 27 | PATH : ∀ {o} → (A : Set o) → Category o o 28 | PATH A = record 29 | { Obj = A 30 | ; _⇒_ = _≡_ 31 | ; id = refl 32 | ; _∘_ = λ p q → q ∙ p 33 | ; assoc = λ {_ _ _ _ f g h} j i → ∙-assoc f g h j i 34 | ; identityˡ = λ {_ _ f} j i → ∙-identityʳ f (~ j) i 35 | ; identityʳ = λ {_ _ f} j i → ∙-identityˡ f (~ j) i 36 | } 37 | 38 | cong-homo-filler : ∀ {x y z : A} → 39 | (f : A → B) → (p : x ≡ y) → (q : y ≡ z) → 40 | I → I → I → B 41 | cong-homo-filler {x = x} f p q k j i = 42 | hfill (λ k → λ { (i = i0) → f x 43 | ; (i = i1) → cong f q k 44 | ; (j = i1) → f (compPath-filler p q k i) 45 | }) (inS (cong f p i)) k 46 | 47 | cong-homo : ∀ {x y z : A} → (f : A → B) → 48 | (p : x ≡ y) → (q : y ≡ z) → 49 | cong f p ∙ cong f q ≡ cong f (p ∙ q) 50 | cong-homo f p q j i = cong-homo-filler f p q i1 j i 51 | 52 | {- 53 | Every function between two types is a functor between 54 | their underlying groupoids. 55 | -} 56 | liftF : ∀ (f : A → B) → Functor (PATH A) (PATH B) 57 | liftF f = record 58 | { F₀ = f 59 | ; F₁ = cong f 60 | ; identity = λ {a} j i → f a 61 | ; homomorphism = λ {a b c p q} j i → cong-homo f p q (~ j) i 62 | } 63 | -------------------------------------------------------------------------------- /src/Categories/Category/Op.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Category.Op where 3 | 4 | open import Categories.Category.Core 5 | 6 | _ᵒᵖ : ∀ {o ℓ} → Category o ℓ → Category o ℓ 7 | C ᵒᵖ = record 8 | { Obj = C.Obj 9 | ; _⇒_ = λ a b → b ⇒ a 10 | ; id = C.id 11 | ; _∘_ = λ f g → g ∘ f 12 | ; assoc = {!!} 13 | ; identityˡ = {!!} 14 | ; identityʳ = {!!} 15 | } 16 | where 17 | module C = Category C 18 | open C 19 | -------------------------------------------------------------------------------- /src/Categories/Category/Product.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Category.Product where 3 | 4 | open import Level 5 | 6 | open import Data.Product using (_,_; proj₁; proj₂) renaming (_×_ to _×′_) 7 | 8 | open import Categories.Category 9 | 10 | private 11 | variable 12 | o ℓ o′ ℓ′ : Level 13 | 14 | _×_ : ∀ (C : Category o ℓ) → (D : Category o′ ℓ′) → Category (o ⊔ o′) (ℓ ⊔ ℓ′) 15 | C × D = record 16 | { Obj = C.Obj ×′ D.Obj 17 | ; _⇒_ = λ A B → C [ proj₁ A , proj₁ B ] ×′ D [ proj₂ A , proj₂ B ] 18 | ; id = C.id , D.id 19 | ; _∘_ = λ (f , g) (h , i) → C [ f ∘ h ] , D [ g ∘ i ] 20 | ; assoc = λ {_ _ _ _ f g h} i → 21 | C.assoc {f = proj₁ f} {g = proj₁ g} {h = proj₁ h} i , 22 | D.assoc {f = proj₂ f} {g = proj₂ g} {h = proj₂ h} i 23 | ; identityˡ = λ {_ _ f} i → 24 | (C.identityˡ {f = proj₁ f} i) , (D.identityˡ {f = proj₂ f} i) 25 | ; identityʳ = λ {_ _ f} i → 26 | (C.identityʳ {f = proj₁ f} i) , (D.identityʳ {f = proj₂ f} i) 27 | } 28 | where 29 | module C = Category C 30 | module D = Category D 31 | 32 | -------------------------------------------------------------------------------- /src/Categories/Category/Properties/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | 3 | open import Categories.Category.Core 4 | 5 | module Categories.Category.Properties.Core {o ℓ} (C : Category o ℓ) where 6 | 7 | open import Cubical.Foundations.Prelude 8 | 9 | open Category C 10 | 11 | id-unique : ∀ {a} {f : a ⇒ a} → (∀ {b} → (g : a ⇒ b) → g ∘ f ≡ g) → f ≡ id 12 | id-unique {f = f} g∘f≡g = 13 | f ≡⟨ sym identityˡ ⟩ 14 | id ∘ f ≡⟨ g∘f≡g id ⟩ 15 | id ∎ 16 | 17 | id-comm : ∀ {a b} {f : a ⇒ b} → f ∘ id ≡ id ∘ f 18 | id-comm {f = f} = 19 | f ∘ id ≡⟨ identityʳ ⟩ 20 | f ≡⟨ sym identityˡ ⟩ 21 | id ∘ f ∎ 22 | -------------------------------------------------------------------------------- /src/Categories/CommutativeDiagram/Square.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | 3 | open import Categories.Category 4 | 5 | module Categories.CommutativeDiagram.Square {o ℓ} (C : Category o ℓ) where 6 | 7 | open import Cubical.Foundations.Prelude 8 | 9 | open Category C 10 | 11 | private 12 | variable 13 | X Y : Obj 14 | a a′ a″ b b′ b″ c c′ c″ : X ⇒ Y 15 | f g h i : X ⇒ Y 16 | 17 | 18 | CommutativeSquare : ∀ {A B C D} → (f : A ⇒ B) (g : A ⇒ C) (h : B ⇒ D) (i : C ⇒ D) → Set _ 19 | CommutativeSquare f g h i = h ∘ f ≡ i ∘ g 20 | -------------------------------------------------------------------------------- /src/Categories/Functor/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | open import Categories.Category 3 | 4 | module Categories.Functor.Core where 5 | 6 | open import Level 7 | 8 | open import Cubical.Foundations.Prelude 9 | 10 | private 11 | variable 12 | o ℓ o′ ℓ′ o″ ℓ″ o‴ ℓ‴ : Level 13 | 14 | record Functor (𝓒 : Category o ℓ) (𝓓 : Category o′ ℓ′) : Set (o ⊔ ℓ ⊔ o′ ⊔ ℓ′) where 15 | private module 𝓒 = Category 𝓒 16 | private module 𝓓 = Category 𝓓 17 | 18 | field 19 | F₀ : 𝓒.Obj → 𝓓.Obj 20 | F₁ : ∀ {A B} → 𝓒 [ A , B ] → 𝓓 [ F₀ A , F₀ B ] 21 | 22 | identity : ∀ {A} → F₁ (𝓒.id {A}) ≡ 𝓓.id 23 | homomorphism : ∀ {A B C} {f : 𝓒 [ A , B ]} 24 | {g : 𝓒 [ B , C ]} 25 | → F₁ (𝓒 [ g ∘ f ]) ≡ 𝓓 [ F₁ g ∘ F₁ f ] 26 | Endofunctor : Category o ℓ → Set _ 27 | Endofunctor 𝓒 = Functor 𝓒 𝓒 28 | 29 | id : ∀ {𝓒 : Category o ℓ} → Endofunctor 𝓒 30 | id = record 31 | { F₀ = λ x → x 32 | ; F₁ = λ f → f 33 | ; identity = refl 34 | ; homomorphism = refl 35 | } 36 | 37 | infixr 9 _∘F_ 38 | 39 | -- Functor Composition. 40 | -- NOTE: Using the reasoning combinators from `cubical` makes 41 | -- the proofs look nicer, but they add an extra `refl` on 42 | -- to the path. This makes other proofs much more painful, 43 | -- so we should avoid doing so. 44 | _∘F_ : ∀ {𝓒 : Category o ℓ} {𝓓 : Category o′ ℓ′} {𝓔 : Category o″ ℓ″} 45 | → Functor 𝓓 𝓔 → Functor 𝓒 𝓓 → Functor 𝓒 𝓔 46 | _∘F_ F G = record 47 | { F₀ = λ x → F₀ (G₀ x) 48 | ; F₁ = λ f → F₁ (G₁ f) 49 | ; identity = (cong F₁ G.identity) ∙ F.identity 50 | ; homomorphism = λ {X} {Y} {Z} {f = f} {g = g} → (cong F₁ G.homomorphism) ∙ F.homomorphism 51 | } 52 | where 53 | module F = Functor F 54 | module G = Functor G 55 | open F 56 | open G renaming (F₀ to G₀; F₁ to G₁) 57 | -------------------------------------------------------------------------------- /src/Categories/Functor/Properties/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | 3 | module Categories.Functor.Properties.Core where 4 | 5 | open import Cubical.Foundations.Prelude 6 | open import Cubical.Foundations.GroupoidLaws renaming 7 | ( lUnit to ∙-unitˡ 8 | ; rUnit to ∙-unitʳ 9 | ; assoc to ∙-assoc 10 | ) 11 | 12 | open import Categories.Category 13 | open import Categories.Category.Instances.Path using (cong-homo) 14 | open import Categories.Functor.Core renaming (_∘F_ to _∘_; id to Id) 15 | 16 | open import Level 17 | 18 | private 19 | variable 20 | o ℓ o′ : Level 21 | 𝓒 𝓓 𝓔 𝓕 : Category o ℓ 22 | 23 | module _ (F : Functor 𝓒 𝓓) where 24 | private 25 | module 𝓒 = Category 𝓒 26 | module 𝓓 = Category 𝓓 27 | module F = Functor F 28 | 29 | open 𝓒 hiding (_∘_) 30 | open F using (F₀; F₁) 31 | 32 | private 33 | variable 34 | A B E : Obj 35 | f g h i : A ⇒ B 36 | 37 | [_]-resp-∘ : 𝓒 [ f ∘ g ] ≡ h → 𝓓 [ F₁ f ∘ F₁ g ] ≡ F₁ h 38 | [_]-resp-∘ {f = f} {g = g} {h = h} eq = 39 | 𝓓 [ F₁ f ∘ F₁ g ] ≡⟨ sym F.homomorphism ⟩ 40 | F₁ (𝓒 [ f ∘ g ]) ≡⟨ cong F₁ eq ⟩ 41 | F₁ h ∎ 42 | 43 | [_]-resp-square : 𝓒 [ h ∘ f ] ≡ 𝓒 [ i ∘ g ] → 𝓓 [ F₁ h ∘ F₁ f ] ≡ 𝓓 [ F₁ i ∘ F₁ g ] 44 | [_]-resp-square {h = h} {f = f} {i = i} {g = g} sq = 45 | 𝓓 [ F₁ h ∘ F₁ f ] ≡⟨ sym F.homomorphism ⟩ 46 | F₁ (𝓒 [ h ∘ f ]) ≡⟨ cong F₁ sq ⟩ 47 | F₁ (𝓒 [ i ∘ g ]) ≡⟨ F.homomorphism ⟩ 48 | 𝓓 [ F₁ i ∘ F₁ g ] ∎ 49 | 50 | ∘F-identityʳ : F ∘ Id ≡ F 51 | ∘F-identityʳ j = record 52 | { F₀ = F₀ 53 | ; F₁ = F₁ 54 | ; identity = λ i → ∙-unitˡ F.identity (~ j) i 55 | ; homomorphism = λ {_ _ _ f g} i → ∙-unitˡ (F.homomorphism {f = f} {g = g}) (~ j) i 56 | } 57 | 58 | ∘F-identityˡ : Id ∘ F ≡ F 59 | ∘F-identityˡ j = record 60 | { F₀ = F₀ 61 | ; F₁ = F₁ 62 | ; identity = λ i → ∙-unitʳ F.identity (~ j) i 63 | ; homomorphism = λ {_ _ _ f g} i → ∙-unitʳ (F.homomorphism {f = f} {g = g}) (~ j) i 64 | } 65 | 66 | module _ (F : Functor 𝓒 𝓓) (G : Functor 𝓓 𝓔) (H : Functor 𝓔 𝓕) where 67 | private 68 | module F = Functor F 69 | module G = Functor G 70 | module H = Functor H 71 | 72 | open F using (F₀; F₁) 73 | open G renaming (F₀ to G₀; F₁ to G₁) 74 | open H renaming (F₀ to H₀; F₁ to H₁) 75 | 76 | ∘F-assoc-filler : ∀ {A : Set o} {B : Set o′} {w x y : A} {z : B} → (f : A → B) → 77 | (p : w ≡ x) → (q : x ≡ y) → (r : f y ≡ z) → 78 | cong f p ∙ (cong f q ∙ r) ≡ cong f (p ∙ q) ∙ r 79 | ∘F-assoc-filler f p q r = 80 | ∙-assoc (cong f p) (cong f q) r ∙ cong (λ a → a ∙ r) (cong-homo f p q) 81 | 82 | ∘F-assoc : (H ∘ G) ∘ F ≡ H ∘ (G ∘ F) 83 | ∘F-assoc j = record 84 | { F₀ = λ x → H₀ (G₀ (F₀ x)) 85 | ; F₁ = λ f → H₁ (G₁ (F₁ f)) 86 | ; identity = λ i → 87 | ∘F-assoc-filler H₁ (cong G₁ F.identity) G.identity H.identity j i 88 | ; homomorphism = λ {_ _ _ f g} i → 89 | ∘F-assoc-filler H₁ (cong G₁ F.homomorphism) G.homomorphism (H.homomorphism {f = G₁ (F₁ f)} {g = G₁ (F₁ g)}) j i 90 | } 91 | -------------------------------------------------------------------------------- /src/Categories/Monad/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.Monad.Core where 3 | 4 | open import Level 5 | 6 | open import Cubical.Foundations.Prelude 7 | 8 | open import Categories.Category 9 | open import Categories.Functor.Core 10 | open import Categories.NaturalTransformation.Core renaming (id to idN) 11 | 12 | private 13 | variable 14 | o ℓ o′ ℓ′ o″ ℓ″ : Level 15 | 𝓒 𝓓 𝓔 : Category o ℓ 16 | 17 | record Monad (𝓒 : Category o ℓ) : Set (o ⊔ ℓ) where 18 | field 19 | T : Endofunctor 𝓒 20 | η : NaturalTransformation id T 21 | μ : NaturalTransformation (T ∘F T) T 22 | 23 | module T = Functor T 24 | open T public using () renaming (F₀ to T₀; F₁ to T₁) 25 | 26 | 27 | field 28 | assoc : μ ∘ᵛ (T ∘ˡ μ) ∘ᵛ () 29 | -------------------------------------------------------------------------------- /src/Categories/NaturalTransformation/Core.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Categories.NaturalTransformation.Core where 3 | 4 | open import Level 5 | 6 | open import Cubical.Foundations.Prelude 7 | 8 | open import Categories.Category 9 | open import Categories.Functor.Core renaming (id to idF) 10 | open import Categories.Functor.Properties.Core 11 | import Categories.CommutativeDiagram.Square as Square 12 | 13 | private 14 | variable 15 | o ℓ o′ ℓ′ o″ ℓ″ : Level 16 | C D E : Category o ℓ 17 | 18 | 19 | record NaturalTransformation {C : Category o ℓ} 20 | {D : Category o′ ℓ′} 21 | (F G : Functor C D) : Set (o ⊔ ℓ ⊔ o′ ⊔ ℓ′) where 22 | private 23 | module C = Category C 24 | module D = Category D 25 | module F = Functor F 26 | module G = Functor G 27 | open F using (F₀; F₁) 28 | open G using () renaming (F₀ to G₀; F₁ to G₁) 29 | open Square D 30 | 31 | field 32 | η : ∀ X → D [ F₀ X , G₀ X ] 33 | commute : ∀ {X Y} → (f : C [ X , Y ]) → CommutativeSquare (F₁ f) (η X) (η Y) (G₁ f) 34 | 35 | id : ∀ {F : Functor C D} → NaturalTransformation F F 36 | id {C = C} {D = D} {F} = record 37 | { η = λ _ → D.id 38 | ; commute = λ f → 39 | D [ D.id ∘ F₁ f ] ≡⟨ D.identityˡ ⟩ 40 | F₁ f ≡⟨ sym D.identityʳ ⟩ 41 | D [ F₁ f ∘ D.id ] ∎ 42 | } 43 | where 44 | module C = Category C 45 | module D = Category D 46 | module F = Functor F 47 | open F 48 | 49 | -- Vertical Composition 50 | _∘ᵛ_ : ∀ {F G H : Functor C D} → 51 | NaturalTransformation G H → NaturalTransformation F G → NaturalTransformation F H 52 | _∘ᵛ_ {C = C} {D = D} {F} {G} {H} X Y = record 53 | { η = λ q → D [ X.η q ∘ Y.η q ] 54 | ; commute = λ {q} {p} f → glue-□ (X.commute f) (Y.commute f) 55 | } 56 | where 57 | module D = Category D 58 | open import Categories.Reasoning.Commutative D 59 | 60 | module X = NaturalTransformation X 61 | module Y = NaturalTransformation Y 62 | 63 | module F = Functor F 64 | module G = Functor G 65 | module H = Functor H 66 | open F 67 | open G renaming (F₀ to G₀; F₁ to G₁) 68 | open H renaming (F₀ to H₀; F₁ to H₁) 69 | 70 | -- Left Composition of a Functor 71 | _∘ˡ_ : ∀ {G H : Functor C D} (F : Functor D E) → 72 | NaturalTransformation G H → 73 | NaturalTransformation (F ∘F G) (F ∘F H) 74 | _∘ˡ_ {E = E} F α = record 75 | { η = λ X → F₁ (η X) 76 | ; commute = λ f → [ F ]-resp-square (commute f) 77 | } 78 | where 79 | open Functor F 80 | open NaturalTransformation α 81 | -------------------------------------------------------------------------------- /src/Categories/Reasoning/Commutative.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | open import Categories.Category 3 | 4 | -- Reasoning Combinators when dealing with commutative diagrams. 5 | module Categories.Reasoning.Commutative {o ℓ} (𝓒 : Category o ℓ) where 6 | 7 | open import Cubical.Foundations.Prelude 8 | open import Categories.Reasoning.Hom 𝓒 9 | open import Categories.CommutativeDiagram.Square 𝓒 10 | open Category 𝓒 11 | 12 | private 13 | variable 14 | X Y : Obj 15 | a a′ a″ b b′ b″ c c′ c″ : X ⇒ Y 16 | f g h i : X ⇒ Y 17 | 18 | 19 | module Pulls (a∘b≡c : a ∘ b ≡ c) where 20 | 21 | {- 22 | A -- f --> B --- c --> D 23 | \ ^ 24 | \ comm / 25 | b a 26 | \ / 27 | v / 28 | C 29 | -} 30 | pullˡ : a ∘ b ∘ f ≡ c ∘ f 31 | pullˡ {f = f} = 32 | a ∘ b ∘ f ≡⟨ sym assoc ⟩ 33 | (a ∘ b) ∘ f ≡⟨ a∘b≡c ⟩∘⟨refl ⟩ 34 | c ∘ f ∎ 35 | 36 | {- 37 | A --- c --> C -- f --> D 38 | \ ^ 39 | \ comm / 40 | b a 41 | \ / 42 | v / 43 | B 44 | -} 45 | 46 | pullʳ : (f ∘ a) ∘ b ≡ f ∘ c 47 | pullʳ {f = f} = 48 | (f ∘ a) ∘ b ≡⟨ assoc ⟩ 49 | f ∘ a ∘ b ≡⟨ refl⟩∘⟨ a∘b≡c ⟩ 50 | f ∘ c ∎ 51 | 52 | open Pulls public 53 | 54 | module Pushes (c≡a∘b : c ≡ a ∘ b) where 55 | 56 | {- 57 | A -- f --> B --- c --> D 58 | \ ^ 59 | \ comm / 60 | b a 61 | \ / 62 | v / 63 | C 64 | -} 65 | 66 | pushˡ : c ∘ f ≡ a ∘ (b ∘ f) 67 | pushˡ {f = f} = sym (pullˡ (sym c≡a∘b)) 68 | 69 | {- 70 | A --- c --> C -- f --> D 71 | \ ^ 72 | \ comm / 73 | b a 74 | \ / 75 | v / 76 | B 77 | -} 78 | 79 | pushʳ : f ∘ c ≡ (f ∘ a) ∘ b 80 | pushʳ {f = f} = sym (pullʳ (sym c≡a∘b)) 81 | 82 | open Pushes public 83 | 84 | module IntroElim (a≡id : a ≡ id) where 85 | 86 | {- 87 | /- a --\ 88 | / v 89 | A comm A -- f --> b 90 | \ ^ 91 | \- id -/ 92 | -} 93 | 94 | elimʳ : f ∘ a ≡ f 95 | elimʳ {f = f} = 96 | f ∘ a ≡⟨ refl⟩∘⟨ a≡id ⟩ 97 | f ∘ id ≡⟨ identityʳ ⟩ 98 | f ∎ 99 | 100 | introʳ : f ≡ f ∘ a 101 | introʳ = sym elimʳ 102 | 103 | {- 104 | /- a --\ 105 | / v 106 | A -- f --> B comm B 107 | \ ^ 108 | \- id -/ 109 | -} 110 | 111 | elimˡ : a ∘ f ≡ f 112 | elimˡ {f = f} = 113 | a ∘ f ≡⟨ a≡id ⟩∘⟨refl ⟩ 114 | id ∘ f ≡⟨ identityˡ ⟩ 115 | f ∎ 116 | 117 | introˡ : f ≡ a ∘ f 118 | introˡ = sym elimˡ 119 | 120 | module Cancellers (inv : h ∘ i ≡ id) where 121 | 122 | {- 123 | 124 | A 125 | ^ ^ 126 | / \ 127 | f f 128 | / comm \ 129 | / \ 130 | B --- id --> B 131 | \ ^ 132 | \ comm / 133 | i h 134 | \ / 135 | v / 136 | C 137 | -} 138 | 139 | cancelʳ : (f ∘ h) ∘ i ≡ f 140 | cancelʳ {f = f} = 141 | (f ∘ h) ∘ i ≡⟨ pullʳ inv ⟩ 142 | f ∘ id ≡⟨ identityʳ ⟩ 143 | f ∎ 144 | 145 | {- 146 | 147 | A 148 | / \ 149 | / \ 150 | f f 151 | / comm \ 152 | v v 153 | B --- id --> B 154 | \ ^ 155 | \ comm / 156 | i h 157 | \ / 158 | v / 159 | C 160 | -} 161 | cancelˡ : h ∘ i ∘ f ≡ f 162 | cancelˡ {f = f} = 163 | h ∘ i ∘ f ≡⟨ pullˡ inv ⟩ 164 | id ∘ f ≡⟨ identityˡ ⟩ 165 | f ∎ 166 | 167 | -- essentially composition in the arrow category 168 | {- 169 | A₁ -- c --> B₁ 170 | | | 171 | b′ comm b 172 | | | 173 | V V 174 | A₂ -- c′ -> B₂ 175 | | | 176 | a′ comm a 177 | | | 178 | V V 179 | A₃ -- c″ -> B₃ 180 | 181 | then the whole diagram commutes 182 | -} 183 | glue-□ : CommutativeSquare c′ a′ a c″ → 184 | CommutativeSquare c b′ b c′ → 185 | CommutativeSquare c (a′ ∘ b′) (a ∘ b) c″ 186 | glue-□ {c′ = c′} {a′ = a′} {a = a} {c″ = c″} {c = c} {b′ = b′} {b = b} sq-a sq-b = 187 | (a ∘ b) ∘ c ≡⟨ pullʳ sq-b ⟩ 188 | a ∘ (c′ ∘ b′) ≡⟨ pullˡ sq-a ⟩ 189 | (c″ ∘ a′) ∘ b′ ≡⟨ assoc ⟩ 190 | c″ ∘ a′ ∘ b′ ∎ 191 | 192 | 193 | -- essentially composition in the over category 194 | {- 195 | C₂ 196 | / \ 197 | / \ 198 | b′ a″ 199 | / comm \ 200 | v v 201 | A₁ -- a′ --> B₁ 202 | \ ^ 203 | \ comm / 204 | b a 205 | \ / 206 | v / 207 | C₁ 208 | 209 | -} 210 | 211 | glue-◃ʳ : a ∘ b ≡ a′ → a′ ∘ b′ ≡ a″ → a ∘ (b ∘ b′) ≡ a″ 212 | glue-◃ʳ {a = a} {b = b} {a′ = a′} {b′ = b′} {a″ = a″} a∘b≡a′ a′∘b′≡a″ = 213 | a ∘ b ∘ b′ ≡⟨ pullˡ a∘b≡a′ ⟩ 214 | a′ ∘ b′ ≡⟨ a′∘b′≡a″ ⟩ 215 | a″ ∎ 216 | 217 | -- essentially composition in the under category 218 | {- 219 | C₂ 220 | ^ ^ 221 | / \ 222 | b″ a′ 223 | / comm \ 224 | / \ 225 | A₁ -- b′ --> C₁ 226 | \ ^ 227 | \ comm / 228 | b a 229 | \ / 230 | v / 231 | B₁ 232 | 233 | -} 234 | 235 | glue-◃ˡ : a′ ∘ b′ ≡ b″ → a ∘ b ≡ b′ → (a′ ∘ a) ∘ b ≡ b″ 236 | glue-◃ˡ {a′ = a′} {b′ = b′} {b″ = b″} {a = a} {b = b} a′∘b′≡b″ a∘b≡b′ = 237 | (a′ ∘ a) ∘ b ≡⟨ pullʳ a∘b≡b′ ⟩ 238 | a′ ∘ b′ ≡⟨ a′∘b′≡b″ ⟩ 239 | b″ ∎ 240 | -------------------------------------------------------------------------------- /src/Categories/Reasoning/Hom.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | open import Categories.Category 3 | 4 | -- Reasoning Combinators when dealing with composition. 5 | module Categories.Reasoning.Hom {o ℓ} (C : Category o ℓ) where 6 | 7 | open import Cubical.Foundations.Prelude 8 | open Category C 9 | 10 | private 11 | variable 12 | A B : Obj 13 | 14 | infixr 4 _⟩∘⟨_ refl⟩∘⟨_ 15 | infixl 5 _⟩∘⟨refl 16 | 17 | _⟩∘⟨_ : ∀ {M} {f h : M ⇒ B} {g i : A ⇒ M} → f ≡ h → g ≡ i → f ∘ g ≡ h ∘ i 18 | _⟩∘⟨_ f≡h g≡i = cong₂ _∘_ f≡h g≡i 19 | 20 | refl⟩∘⟨_ : ∀ {M} {f : M ⇒ B} {g i : A ⇒ M} → g ≡ i → f ∘ g ≡ f ∘ i 21 | refl⟩∘⟨_ {f = f} g≡i = cong (f ∘_) g≡i 22 | 23 | _⟩∘⟨refl : ∀ {M} {f h : M ⇒ B} {g : A ⇒ M} → f ≡ h → f ∘ g ≡ h ∘ g 24 | _⟩∘⟨refl {g = g} f≡h = cong (_∘ g) f≡h 25 | -------------------------------------------------------------------------------- /src/Categories/Setoid.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical --safe #-} 2 | module Setoid where 3 | 4 | open import Cubical.Foundations.Prelude hiding (_≡⟨_⟩_) 5 | 6 | open import Level 7 | 8 | record Category (o ℓ : Level) : Set (suc (o ⊔ ℓ)) where 9 | 10 | infix 4 _⇒_ 11 | infixr 9 _∘_ 12 | 13 | field 14 | Obj : Set o 15 | _⇒_ : Obj → Obj → Set ℓ 16 | 17 | id : ∀ {A} → A ⇒ A 18 | _∘_ : ∀ {A B C} → (B ⇒ C) → (A ⇒ B) → (A ⇒ C) 19 | 20 | field 21 | assoc : ∀ {A B C D} {f : A ⇒ B} {g : B ⇒ C} {h : C ⇒ D} → (h ∘ g) ∘ f ≡ h ∘ (g ∘ f) 22 | identityˡ : ∀ {A B} {f : A ⇒ B} → id ∘ f ≡ f 23 | identityʳ : ∀ {A B} {f : A ⇒ B} → f ∘ id ≡ f 24 | ∘-resp-≡ : ∀ {A B C} {f h : B ⇒ C} {g i : A ⇒ B} → f ≡ h → g ≡ i → f ∘ g ≡ h ∘ i 25 | 26 | infix 10 _[_,_] _[_∘_] 27 | 28 | _[_,_] : ∀ {o ℓ} → (C : Category o ℓ) → (X : Category.Obj C) → (Y : Category.Obj C) → Set ℓ 29 | _[_,_] = Category._⇒_ 30 | 31 | _[_∘_] : ∀ {o ℓ} → (C : Category o ℓ) → ∀ {X Y Z} (f : C [ Y , Z ]) → (g : C [ X , Y ]) → C [ X , Z ] 32 | _[_∘_] = Category._∘_ 33 | 34 | record Functor {o ℓ o′ ℓ′} (C : Category o ℓ) (D : Category o′ ℓ′) : Set (o ⊔ ℓ ⊔ o′ ⊔ ℓ′) where 35 | private module C = Category C 36 | private module D = Category D 37 | 38 | field 39 | F₀ : C.Obj → D.Obj 40 | F₁ : ∀ {A B} → C [ A , B ] → D [ F₀ A , F₀ B ] 41 | 42 | identity : ∀ {A} → F₁ (C.id {A}) ≡ D.id 43 | homomorphism : ∀ {X Y Z} {f : C [ X , Y ]} {g : C [ Y , Z ]} → D [ F₁ g ∘ F₁ f ] ≡ F₁ (C [ g ∘ f ]) 44 | F-resp-≡ : ∀ {A B} {f g : C [ A , B ]} → f ≡ g → F₁ f ≡ F₁ g 45 | 46 | record NaturalTransformation {o ℓ o′ ℓ′} {C : Category o ℓ} {D : Category o′ ℓ′} (F G : Functor C D) : Set (o ⊔ ℓ ⊔ o′ ⊔ ℓ′) where 47 | private 48 | module C = Category C 49 | module D = Category D 50 | module F = Functor F 51 | module G = Functor G 52 | open F using (F₀; F₁) 53 | open G using () renaming (F₀ to G₀; F₁ to G₁) 54 | field 55 | τ : ∀ X → D [ F₀ X , G₀ X ] 56 | commute : ∀ {A B} → D [ τ B ∘ --------------------------------------------------------------------------------