2018-02-25 14:21:38 +00:00
|
|
|
|
-- | Univalent categories
|
|
|
|
|
--
|
|
|
|
|
-- This module defines:
|
|
|
|
|
--
|
|
|
|
|
-- Categories
|
|
|
|
|
-- ==========
|
|
|
|
|
--
|
|
|
|
|
-- Types
|
|
|
|
|
-- ------
|
|
|
|
|
--
|
|
|
|
|
-- Object, Arrow
|
|
|
|
|
--
|
|
|
|
|
-- Data
|
|
|
|
|
-- ----
|
|
|
|
|
-- 𝟙; the identity arrow
|
|
|
|
|
-- _∘_; function composition
|
|
|
|
|
--
|
|
|
|
|
-- Laws
|
|
|
|
|
-- ----
|
|
|
|
|
--
|
|
|
|
|
-- associativity, identity, arrows form sets, univalence.
|
|
|
|
|
--
|
|
|
|
|
-- Lemmas
|
|
|
|
|
-- ------
|
|
|
|
|
--
|
|
|
|
|
-- Propositionality for all laws about the category.
|
2018-02-02 14:33:54 +00:00
|
|
|
|
{-# OPTIONS --allow-unsolved-metas --cubical #-}
|
2017-11-10 15:00:00 +00:00
|
|
|
|
|
2018-01-08 21:48:59 +00:00
|
|
|
|
module Cat.Category where
|
2017-11-10 15:00:00 +00:00
|
|
|
|
|
2018-03-21 13:39:56 +00:00
|
|
|
|
open import Cat.Prelude
|
|
|
|
|
renaming
|
2018-01-20 23:21:25 +00:00
|
|
|
|
( proj₁ to fst
|
|
|
|
|
; proj₂ to snd
|
|
|
|
|
)
|
|
|
|
|
|
2018-03-21 13:39:56 +00:00
|
|
|
|
import Function
|
2018-01-20 23:21:25 +00:00
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
------------------
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- * Categories --
|
2018-03-22 13:27:16 +00:00
|
|
|
|
------------------
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
|
|
|
|
-- | Raw categories
|
|
|
|
|
--
|
|
|
|
|
-- This record desribes the data that a category consist of as well as some laws
|
|
|
|
|
-- about these. The laws defined are the types the propositions - not the
|
|
|
|
|
-- witnesses to them!
|
2018-02-20 15:22:38 +00:00
|
|
|
|
record RawCategory (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
2018-02-05 10:43:38 +00:00
|
|
|
|
no-eta-equality
|
|
|
|
|
field
|
2018-02-20 15:22:38 +00:00
|
|
|
|
Object : Set ℓa
|
|
|
|
|
Arrow : Object → Object → Set ℓb
|
|
|
|
|
𝟙 : {A : Object} → Arrow A A
|
2018-02-05 10:43:38 +00:00
|
|
|
|
_∘_ : {A B C : Object} → Arrow B C → Arrow A B → Arrow A C
|
2018-02-20 15:22:38 +00:00
|
|
|
|
|
2018-03-06 14:52:22 +00:00
|
|
|
|
infixl 10 _∘_ _>>>_
|
2018-02-20 15:22:38 +00:00
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | Operations on data
|
|
|
|
|
|
2018-02-05 10:43:38 +00:00
|
|
|
|
domain : { a b : Object } → Arrow a b → Object
|
|
|
|
|
domain {a = a} _ = a
|
2018-02-20 15:22:38 +00:00
|
|
|
|
|
2018-02-05 10:43:38 +00:00
|
|
|
|
codomain : { a b : Object } → Arrow a b → Object
|
|
|
|
|
codomain {b = b} _ = b
|
|
|
|
|
|
2018-02-26 18:59:11 +00:00
|
|
|
|
_>>>_ : {A B C : Object} → (Arrow A B) → (Arrow B C) → Arrow A C
|
|
|
|
|
f >>> g = g ∘ f
|
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | Laws about the data
|
|
|
|
|
|
2018-03-08 00:09:40 +00:00
|
|
|
|
-- FIXME It seems counter-intuitive that the normal-form is on the
|
2018-02-24 19:37:21 +00:00
|
|
|
|
-- right-hand-side.
|
2018-02-20 15:22:38 +00:00
|
|
|
|
IsAssociative : Set (ℓa ⊔ ℓb)
|
|
|
|
|
IsAssociative = ∀ {A B C D} {f : Arrow A B} {g : Arrow B C} {h : Arrow C D}
|
|
|
|
|
→ h ∘ (g ∘ f) ≡ (h ∘ g) ∘ f
|
|
|
|
|
|
|
|
|
|
IsIdentity : ({A : Object} → Arrow A A) → Set (ℓa ⊔ ℓb)
|
|
|
|
|
IsIdentity id = {A B : Object} {f : Arrow A B}
|
2018-03-21 10:46:36 +00:00
|
|
|
|
→ id ∘ f ≡ f × f ∘ id ≡ f
|
2018-02-20 15:22:38 +00:00
|
|
|
|
|
2018-02-23 09:35:42 +00:00
|
|
|
|
ArrowsAreSets : Set (ℓa ⊔ ℓb)
|
|
|
|
|
ArrowsAreSets = ∀ {A B : Object} → isSet (Arrow A B)
|
|
|
|
|
|
2018-02-20 15:22:38 +00:00
|
|
|
|
IsInverseOf : ∀ {A B} → (Arrow A B) → (Arrow B A) → Set ℓb
|
|
|
|
|
IsInverseOf = λ f g → g ∘ f ≡ 𝟙 × f ∘ g ≡ 𝟙
|
|
|
|
|
|
|
|
|
|
Isomorphism : ∀ {A B} → (f : Arrow A B) → Set ℓb
|
|
|
|
|
Isomorphism {A} {B} f = Σ[ g ∈ Arrow B A ] IsInverseOf f g
|
|
|
|
|
|
|
|
|
|
_≅_ : (A B : Object) → Set ℓb
|
|
|
|
|
_≅_ A B = Σ[ f ∈ Arrow A B ] (Isomorphism f)
|
|
|
|
|
|
|
|
|
|
module _ {A B : Object} where
|
|
|
|
|
Epimorphism : {X : Object } → (f : Arrow A B) → Set ℓb
|
|
|
|
|
Epimorphism {X} f = ( g₀ g₁ : Arrow B X ) → g₀ ∘ f ≡ g₁ ∘ f → g₀ ≡ g₁
|
|
|
|
|
|
|
|
|
|
Monomorphism : {X : Object} → (f : Arrow A B) → Set ℓb
|
|
|
|
|
Monomorphism {X} f = ( g₀ g₁ : Arrow X A ) → f ∘ g₀ ≡ f ∘ g₁ → g₀ ≡ g₁
|
|
|
|
|
|
2018-02-21 11:59:31 +00:00
|
|
|
|
IsInitial : Object → Set (ℓa ⊔ ℓb)
|
|
|
|
|
IsInitial I = {X : Object} → isContr (Arrow I X)
|
2018-02-20 17:14:42 +00:00
|
|
|
|
|
|
|
|
|
IsTerminal : Object → Set (ℓa ⊔ ℓb)
|
2018-02-20 17:15:07 +00:00
|
|
|
|
IsTerminal T = {X : Object} → isContr (Arrow X T)
|
2018-02-20 17:14:42 +00:00
|
|
|
|
|
2018-02-21 11:59:31 +00:00
|
|
|
|
Initial : Set (ℓa ⊔ ℓb)
|
|
|
|
|
Initial = Σ Object IsInitial
|
2018-02-20 17:14:42 +00:00
|
|
|
|
|
|
|
|
|
Terminal : Set (ℓa ⊔ ℓb)
|
2018-02-21 11:59:31 +00:00
|
|
|
|
Terminal = Σ Object IsTerminal
|
2018-02-20 17:14:42 +00:00
|
|
|
|
|
2018-03-20 14:19:28 +00:00
|
|
|
|
-- | Univalence is indexed by a raw category as well as an identity proof.
|
|
|
|
|
module Univalence (isIdentity : IsIdentity 𝟙) where
|
2018-03-22 13:27:16 +00:00
|
|
|
|
-- | The identity isomorphism
|
2018-02-20 17:11:14 +00:00
|
|
|
|
idIso : (A : Object) → A ≅ A
|
2018-02-23 11:49:41 +00:00
|
|
|
|
idIso A = 𝟙 , (𝟙 , isIdentity)
|
2018-02-20 17:11:14 +00:00
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
-- | Extract an isomorphism from an equality
|
|
|
|
|
--
|
|
|
|
|
-- [HoTT §9.1.4]
|
2018-02-20 17:11:14 +00:00
|
|
|
|
id-to-iso : (A B : Object) → A ≡ B → A ≅ B
|
|
|
|
|
id-to-iso A B eq = transp (\ i → A ≅ eq i) (idIso A)
|
|
|
|
|
|
|
|
|
|
Univalent : Set (ℓa ⊔ ℓb)
|
|
|
|
|
Univalent = {A B : Object} → isEquiv (A ≡ B) (A ≅ B) (id-to-iso A B)
|
2018-03-15 10:04:15 +00:00
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
-- A perhaps more readable version of univalence:
|
|
|
|
|
Univalent≃ = {A B : Object} → (A ≡ B) ≃ (A ≅ B)
|
|
|
|
|
|
2018-03-21 16:52:32 +00:00
|
|
|
|
-- | Equivalent formulation of univalence.
|
|
|
|
|
Univalent[Contr] : Set _
|
|
|
|
|
Univalent[Contr] = ∀ A → isContr (Σ[ X ∈ Object ] A ≅ X)
|
2018-03-21 13:39:56 +00:00
|
|
|
|
|
2018-03-21 16:52:32 +00:00
|
|
|
|
-- From: Thierry Coquand <Thierry.Coquand@cse.gu.se>
|
|
|
|
|
-- Date: Wed, Mar 21, 2018 at 3:12 PM
|
|
|
|
|
--
|
|
|
|
|
-- This is not so straight-forward so you can assume it
|
|
|
|
|
postulate from[Contr] : Univalent[Contr] → Univalent
|
2018-02-20 17:11:14 +00:00
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | The mere proposition of being a category.
|
|
|
|
|
--
|
|
|
|
|
-- Also defines a few lemmas:
|
|
|
|
|
--
|
|
|
|
|
-- iso-is-epi : Isomorphism f → Epimorphism {X = X} f
|
|
|
|
|
-- iso-is-mono : Isomorphism f → Monomorphism {X = X} f
|
|
|
|
|
--
|
2018-03-12 12:36:55 +00:00
|
|
|
|
-- Sans `univalent` this would be what is referred to as a pre-category in
|
|
|
|
|
-- [HoTT].
|
2018-02-05 10:43:38 +00:00
|
|
|
|
record IsCategory {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) : Set (lsuc (ℓa ⊔ ℓb)) where
|
2018-02-25 13:37:28 +00:00
|
|
|
|
open RawCategory ℂ public
|
2018-01-21 13:31:37 +00:00
|
|
|
|
field
|
2018-02-23 11:43:49 +00:00
|
|
|
|
isAssociative : IsAssociative
|
2018-02-23 11:52:14 +00:00
|
|
|
|
isIdentity : IsIdentity 𝟙
|
2018-02-23 11:51:44 +00:00
|
|
|
|
arrowsAreSets : ArrowsAreSets
|
2018-03-20 14:19:28 +00:00
|
|
|
|
open Univalence isIdentity public
|
|
|
|
|
field
|
|
|
|
|
univalent : Univalent
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
2018-03-21 10:46:36 +00:00
|
|
|
|
leftIdentity : {A B : Object} {f : Arrow A B} → 𝟙 ∘ f ≡ f
|
|
|
|
|
leftIdentity {A} {B} {f} = fst (isIdentity {A = A} {B} {f})
|
|
|
|
|
|
|
|
|
|
rightIdentity : {A B : Object} {f : Arrow A B} → f ∘ 𝟙 ≡ f
|
|
|
|
|
rightIdentity {A} {B} {f} = snd (isIdentity {A = A} {B} {f})
|
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
------------
|
|
|
|
|
-- Lemmas --
|
|
|
|
|
------------
|
|
|
|
|
|
|
|
|
|
-- | Relation between iso- epi- and mono- morphisms.
|
2018-02-25 13:44:03 +00:00
|
|
|
|
module _ {A B : Object} {X : Object} (f : Arrow A B) where
|
2018-03-22 13:27:16 +00:00
|
|
|
|
iso→epi : Isomorphism f → Epimorphism {X = X} f
|
|
|
|
|
iso→epi (f- , left-inv , right-inv) g₀ g₁ eq = begin
|
2018-03-21 10:46:36 +00:00
|
|
|
|
g₀ ≡⟨ sym rightIdentity ⟩
|
2018-02-25 13:44:03 +00:00
|
|
|
|
g₀ ∘ 𝟙 ≡⟨ cong (_∘_ g₀) (sym right-inv) ⟩
|
|
|
|
|
g₀ ∘ (f ∘ f-) ≡⟨ isAssociative ⟩
|
|
|
|
|
(g₀ ∘ f) ∘ f- ≡⟨ cong (λ φ → φ ∘ f-) eq ⟩
|
|
|
|
|
(g₁ ∘ f) ∘ f- ≡⟨ sym isAssociative ⟩
|
|
|
|
|
g₁ ∘ (f ∘ f-) ≡⟨ cong (_∘_ g₁) right-inv ⟩
|
2018-03-21 10:46:36 +00:00
|
|
|
|
g₁ ∘ 𝟙 ≡⟨ rightIdentity ⟩
|
2018-02-25 13:44:03 +00:00
|
|
|
|
g₁ ∎
|
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
iso→mono : Isomorphism f → Monomorphism {X = X} f
|
|
|
|
|
iso→mono (f- , left-inv , right-inv) g₀ g₁ eq =
|
2018-02-25 13:44:03 +00:00
|
|
|
|
begin
|
2018-03-21 10:46:36 +00:00
|
|
|
|
g₀ ≡⟨ sym leftIdentity ⟩
|
2018-02-25 13:44:03 +00:00
|
|
|
|
𝟙 ∘ g₀ ≡⟨ cong (λ φ → φ ∘ g₀) (sym left-inv) ⟩
|
|
|
|
|
(f- ∘ f) ∘ g₀ ≡⟨ sym isAssociative ⟩
|
|
|
|
|
f- ∘ (f ∘ g₀) ≡⟨ cong (_∘_ f-) eq ⟩
|
|
|
|
|
f- ∘ (f ∘ g₁) ≡⟨ isAssociative ⟩
|
|
|
|
|
(f- ∘ f) ∘ g₁ ≡⟨ cong (λ φ → φ ∘ g₁) left-inv ⟩
|
2018-03-21 10:46:36 +00:00
|
|
|
|
𝟙 ∘ g₁ ≡⟨ leftIdentity ⟩
|
2018-02-25 13:44:03 +00:00
|
|
|
|
g₁ ∎
|
|
|
|
|
|
2018-03-22 13:27:16 +00:00
|
|
|
|
iso→epi×mono : Isomorphism f → Epimorphism {X = X} f × Monomorphism {X = X} f
|
|
|
|
|
iso→epi×mono iso = iso→epi iso , iso→mono iso
|
|
|
|
|
|
|
|
|
|
-- | The formulation of univalence expressed with _≃_ is trivially admissable -
|
|
|
|
|
-- just "forget" the equivalence.
|
|
|
|
|
univalent≃ : Univalent≃
|
|
|
|
|
univalent≃ = _ , univalent
|
2018-02-01 14:20:20 +00:00
|
|
|
|
|
2018-03-21 11:17:10 +00:00
|
|
|
|
-- | All projections are propositions.
|
|
|
|
|
module Propositionality where
|
2018-02-20 16:59:48 +00:00
|
|
|
|
propIsAssociative : isProp IsAssociative
|
2018-02-23 11:51:44 +00:00
|
|
|
|
propIsAssociative x y i = arrowsAreSets _ _ x y i
|
2018-02-20 16:59:48 +00:00
|
|
|
|
|
|
|
|
|
propIsIdentity : ∀ {f : ∀ {A} → Arrow A A} → isProp (IsIdentity f)
|
|
|
|
|
propIsIdentity a b i
|
2018-02-23 11:51:44 +00:00
|
|
|
|
= arrowsAreSets _ _ (fst a) (fst b) i
|
|
|
|
|
, arrowsAreSets _ _ (snd a) (snd b) i
|
2018-02-20 16:59:48 +00:00
|
|
|
|
|
|
|
|
|
propArrowIsSet : isProp (∀ {A B} → isSet (Arrow A B))
|
|
|
|
|
propArrowIsSet a b i = isSetIsProp a b i
|
|
|
|
|
|
|
|
|
|
propIsInverseOf : ∀ {A B f g} → isProp (IsInverseOf {A} {B} f g)
|
|
|
|
|
propIsInverseOf x y = λ i →
|
|
|
|
|
let
|
|
|
|
|
h : fst x ≡ fst y
|
2018-02-23 11:51:44 +00:00
|
|
|
|
h = arrowsAreSets _ _ (fst x) (fst y)
|
2018-02-20 16:59:48 +00:00
|
|
|
|
hh : snd x ≡ snd y
|
2018-02-23 11:51:44 +00:00
|
|
|
|
hh = arrowsAreSets _ _ (snd x) (snd y)
|
2018-02-20 16:59:48 +00:00
|
|
|
|
in h i , hh i
|
|
|
|
|
|
|
|
|
|
module _ {A B : Object} {f : Arrow A B} where
|
|
|
|
|
isoIsProp : isProp (Isomorphism f)
|
|
|
|
|
isoIsProp a@(g , η , ε) a'@(g' , η' , ε') =
|
|
|
|
|
lemSig (λ g → propIsInverseOf) a a' geq
|
|
|
|
|
where
|
|
|
|
|
geq : g ≡ g'
|
|
|
|
|
geq = begin
|
2018-03-21 10:46:36 +00:00
|
|
|
|
g ≡⟨ sym rightIdentity ⟩
|
2018-02-20 16:59:48 +00:00
|
|
|
|
g ∘ 𝟙 ≡⟨ cong (λ φ → g ∘ φ) (sym ε') ⟩
|
2018-02-23 11:43:49 +00:00
|
|
|
|
g ∘ (f ∘ g') ≡⟨ isAssociative ⟩
|
2018-02-20 16:59:48 +00:00
|
|
|
|
(g ∘ f) ∘ g' ≡⟨ cong (λ φ → φ ∘ g') η ⟩
|
2018-03-21 10:46:36 +00:00
|
|
|
|
𝟙 ∘ g' ≡⟨ leftIdentity ⟩
|
2018-02-20 16:59:48 +00:00
|
|
|
|
g' ∎
|
|
|
|
|
|
2018-03-20 14:19:28 +00:00
|
|
|
|
propUnivalent : isProp Univalent
|
2018-03-22 13:27:16 +00:00
|
|
|
|
propUnivalent a b i = propPi (λ iso → propIsContr) a b i
|
2018-02-20 16:59:48 +00:00
|
|
|
|
|
2018-03-21 11:17:10 +00:00
|
|
|
|
-- | Propositionality of being a category
|
|
|
|
|
module _ {ℓa ℓb : Level} (ℂ : RawCategory ℓa ℓb) where
|
|
|
|
|
open RawCategory ℂ
|
|
|
|
|
open Univalence
|
2018-02-20 15:42:56 +00:00
|
|
|
|
private
|
2018-03-12 12:51:29 +00:00
|
|
|
|
module _ (x y : IsCategory ℂ) where
|
2018-02-20 15:42:56 +00:00
|
|
|
|
module X = IsCategory x
|
|
|
|
|
module Y = IsCategory y
|
2018-02-20 16:59:48 +00:00
|
|
|
|
-- In a few places I use the result of propositionality of the various
|
2018-03-21 11:17:10 +00:00
|
|
|
|
-- projections of `IsCategory` - Here I arbitrarily chose to use this
|
2018-02-20 16:59:48 +00:00
|
|
|
|
-- result from `x : IsCategory C`. I don't know which (if any) possibly
|
|
|
|
|
-- adverse effects this may have.
|
2018-03-21 11:17:10 +00:00
|
|
|
|
module Prop = X.Propositionality
|
|
|
|
|
|
2018-02-23 11:49:41 +00:00
|
|
|
|
isIdentity : (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ Y.isIdentity ]
|
2018-03-21 11:17:10 +00:00
|
|
|
|
isIdentity = Prop.propIsIdentity X.isIdentity Y.isIdentity
|
2018-02-23 09:35:42 +00:00
|
|
|
|
U : ∀ {a : IsIdentity 𝟙}
|
2018-02-23 11:49:41 +00:00
|
|
|
|
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ a ]
|
2018-02-23 09:35:42 +00:00
|
|
|
|
→ (b : Univalent a)
|
|
|
|
|
→ Set _
|
2018-03-12 12:36:55 +00:00
|
|
|
|
U eqwal univ =
|
2018-02-23 09:35:42 +00:00
|
|
|
|
(λ i → Univalent (eqwal i))
|
2018-03-12 12:36:55 +00:00
|
|
|
|
[ X.univalent ≡ univ ]
|
2018-02-20 16:44:44 +00:00
|
|
|
|
P : (y : IsIdentity 𝟙)
|
2018-02-23 11:49:41 +00:00
|
|
|
|
→ (λ _ → IsIdentity 𝟙) [ X.isIdentity ≡ y ] → Set _
|
2018-03-12 12:36:55 +00:00
|
|
|
|
P y eq = ∀ (univ : Univalent y) → U eq univ
|
|
|
|
|
p : ∀ (b' : Univalent X.isIdentity)
|
2018-02-23 11:49:41 +00:00
|
|
|
|
→ (λ _ → Univalent X.isIdentity) [ X.univalent ≡ b' ]
|
2018-03-21 11:17:10 +00:00
|
|
|
|
p univ = Prop.propUnivalent X.univalent univ
|
2018-03-12 12:36:55 +00:00
|
|
|
|
helper : P Y.isIdentity isIdentity
|
|
|
|
|
helper = pathJ P p Y.isIdentity isIdentity
|
2018-02-23 11:49:41 +00:00
|
|
|
|
eqUni : U isIdentity Y.univalent
|
2018-03-12 12:36:55 +00:00
|
|
|
|
eqUni = helper Y.univalent
|
|
|
|
|
done : x ≡ y
|
2018-03-21 11:17:10 +00:00
|
|
|
|
IsCategory.isAssociative (done i) = Prop.propIsAssociative X.isAssociative Y.isAssociative i
|
|
|
|
|
IsCategory.isIdentity (done i) = isIdentity i
|
|
|
|
|
IsCategory.arrowsAreSets (done i) = Prop.propArrowIsSet X.arrowsAreSets Y.arrowsAreSets i
|
|
|
|
|
IsCategory.univalent (done i) = eqUni i
|
2018-02-07 19:19:17 +00:00
|
|
|
|
|
2018-03-12 12:51:29 +00:00
|
|
|
|
propIsCategory : isProp (IsCategory ℂ)
|
2018-02-20 15:42:56 +00:00
|
|
|
|
propIsCategory = done
|
2018-01-21 13:31:37 +00:00
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | Univalent categories
|
|
|
|
|
--
|
2018-03-12 12:36:55 +00:00
|
|
|
|
-- Just bundles up the data with witnesses inhabiting the propositions.
|
2018-02-05 13:47:15 +00:00
|
|
|
|
record Category (ℓa ℓb : Level) : Set (lsuc (ℓa ⊔ ℓb)) where
|
|
|
|
|
field
|
2018-03-12 12:36:55 +00:00
|
|
|
|
raw : RawCategory ℓa ℓb
|
2018-02-05 13:47:15 +00:00
|
|
|
|
{{isCategory}} : IsCategory raw
|
2018-02-05 10:43:38 +00:00
|
|
|
|
|
2018-02-21 12:37:07 +00:00
|
|
|
|
open IsCategory isCategory public
|
2018-02-05 10:43:38 +00:00
|
|
|
|
|
2018-03-12 12:36:55 +00:00
|
|
|
|
-- The fact that being a category is a mere proposition gives rise to this
|
|
|
|
|
-- equality principle for categories.
|
|
|
|
|
module _ {ℓa ℓb : Level} {ℂ 𝔻 : Category ℓa ℓb} where
|
|
|
|
|
private
|
|
|
|
|
module ℂ = Category ℂ
|
|
|
|
|
module 𝔻 = Category 𝔻
|
|
|
|
|
|
|
|
|
|
module _ (rawEq : ℂ.raw ≡ 𝔻.raw) where
|
|
|
|
|
private
|
|
|
|
|
isCategoryEq : (λ i → IsCategory (rawEq i)) [ ℂ.isCategory ≡ 𝔻.isCategory ]
|
2018-03-21 11:17:10 +00:00
|
|
|
|
isCategoryEq = lemPropF propIsCategory rawEq
|
2018-03-12 12:36:55 +00:00
|
|
|
|
|
|
|
|
|
Category≡ : ℂ ≡ 𝔻
|
|
|
|
|
Category≡ i = record
|
|
|
|
|
{ raw = rawEq i
|
|
|
|
|
; isCategory = isCategoryEq i
|
|
|
|
|
}
|
2018-03-08 00:09:40 +00:00
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | Syntax for arrows- and composition in a given category.
|
2018-02-21 12:37:07 +00:00
|
|
|
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
|
|
|
|
open Category ℂ
|
2018-02-05 11:21:39 +00:00
|
|
|
|
_[_,_] : (A : Object) → (B : Object) → Set ℓb
|
2018-02-20 15:25:49 +00:00
|
|
|
|
_[_,_] = Arrow
|
2017-11-10 15:00:00 +00:00
|
|
|
|
|
2018-02-20 15:25:49 +00:00
|
|
|
|
_[_∘_] : {A B C : Object} → (g : Arrow B C) → (f : Arrow A B) → Arrow A C
|
|
|
|
|
_[_∘_] = _∘_
|
2017-11-10 15:00:00 +00:00
|
|
|
|
|
2018-02-25 14:21:38 +00:00
|
|
|
|
-- | The opposite category
|
|
|
|
|
--
|
|
|
|
|
-- The opposite category is the category where the direction of the arrows are
|
|
|
|
|
-- flipped.
|
|
|
|
|
module Opposite {ℓa ℓb : Level} where
|
|
|
|
|
module _ (ℂ : Category ℓa ℓb) where
|
|
|
|
|
private
|
2018-03-05 15:10:27 +00:00
|
|
|
|
module ℂ = Category ℂ
|
2018-02-25 14:21:38 +00:00
|
|
|
|
opRaw : RawCategory ℓa ℓb
|
2018-03-05 15:10:27 +00:00
|
|
|
|
RawCategory.Object opRaw = ℂ.Object
|
|
|
|
|
RawCategory.Arrow opRaw = Function.flip ℂ.Arrow
|
|
|
|
|
RawCategory.𝟙 opRaw = ℂ.𝟙
|
|
|
|
|
RawCategory._∘_ opRaw = Function.flip ℂ._∘_
|
|
|
|
|
|
|
|
|
|
open RawCategory opRaw
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
2018-03-05 15:10:27 +00:00
|
|
|
|
isIdentity : IsIdentity 𝟙
|
|
|
|
|
isIdentity = swap ℂ.isIdentity
|
|
|
|
|
|
2018-03-20 14:19:28 +00:00
|
|
|
|
open Univalence isIdentity
|
|
|
|
|
|
2018-03-05 15:10:27 +00:00
|
|
|
|
module _ {A B : ℂ.Object} where
|
|
|
|
|
univalent : isEquiv (A ≡ B) (A ≅ B)
|
2018-03-20 14:19:28 +00:00
|
|
|
|
(Univalence.id-to-iso (swap ℂ.isIdentity) A B)
|
2018-03-05 15:10:27 +00:00
|
|
|
|
fst (univalent iso) = flipFiber (fst (ℂ.univalent (flipIso iso)))
|
|
|
|
|
where
|
|
|
|
|
flipIso : A ≅ B → B ℂ.≅ A
|
|
|
|
|
flipIso (f , f~ , iso) = f , f~ , swap iso
|
|
|
|
|
flipFiber
|
2018-03-20 14:19:28 +00:00
|
|
|
|
: fiber (ℂ.id-to-iso B A) (flipIso iso)
|
|
|
|
|
→ fiber ( id-to-iso A B) iso
|
2018-03-05 15:10:27 +00:00
|
|
|
|
flipFiber (eq , eqIso) = sym eq , {!!}
|
|
|
|
|
snd (univalent iso) = {!!}
|
|
|
|
|
|
|
|
|
|
isCategory : IsCategory opRaw
|
|
|
|
|
IsCategory.isAssociative isCategory = sym ℂ.isAssociative
|
|
|
|
|
IsCategory.isIdentity isCategory = isIdentity
|
|
|
|
|
IsCategory.arrowsAreSets isCategory = ℂ.arrowsAreSets
|
|
|
|
|
IsCategory.univalent isCategory = univalent
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
|
|
|
|
opposite : Category ℓa ℓb
|
2018-03-05 15:10:27 +00:00
|
|
|
|
Category.raw opposite = opRaw
|
|
|
|
|
Category.isCategory opposite = isCategory
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
|
|
|
|
-- As demonstrated here a side-effect of having no-eta-equality on constructors
|
|
|
|
|
-- means that we need to pick things apart to show that things are indeed
|
|
|
|
|
-- definitionally equal. I.e; a thing that would normally be provable in one
|
|
|
|
|
-- line now takes 13!! Admittedly it's a simple proof.
|
|
|
|
|
module _ {ℂ : Category ℓa ℓb} where
|
|
|
|
|
open Category ℂ
|
|
|
|
|
private
|
|
|
|
|
-- Since they really are definitionally equal we just need to pick apart
|
|
|
|
|
-- the data-type.
|
|
|
|
|
rawInv : Category.raw (opposite (opposite ℂ)) ≡ raw
|
|
|
|
|
RawCategory.Object (rawInv _) = Object
|
|
|
|
|
RawCategory.Arrow (rawInv _) = Arrow
|
|
|
|
|
RawCategory.𝟙 (rawInv _) = 𝟙
|
|
|
|
|
RawCategory._∘_ (rawInv _) = _∘_
|
|
|
|
|
|
|
|
|
|
oppositeIsInvolution : opposite (opposite ℂ) ≡ ℂ
|
2018-03-08 00:09:40 +00:00
|
|
|
|
oppositeIsInvolution = Category≡ rawInv
|
2018-02-25 14:21:38 +00:00
|
|
|
|
|
2018-02-25 14:23:33 +00:00
|
|
|
|
open Opposite public
|