diff --git a/src/Categories/Object/Duality.agda b/src/Categories/Object/Duality.agda index c5ff47339..c8cdd9a00 100644 --- a/src/Categories/Object/Duality.agda +++ b/src/Categories/Object/Duality.agda @@ -17,6 +17,7 @@ open import Categories.Object.Initial C open import Categories.Object.Product op open import Categories.Object.Coproduct C +open import Categories.Object.Zero IsInitial⇒coIsTerminal : ∀ {X} → IsInitial X → IsTerminal X IsInitial⇒coIsTerminal is⊥ = record @@ -72,6 +73,40 @@ coProduct⇒Coproduct A×B = record where module A×B = Product A×B +-- Zero objects are autodual +IsZero⇒coIsZero : ∀ {Z} → IsZero C Z → IsZero op Z +IsZero⇒coIsZero is-zero = record + { isInitial = record { ! = ! ; !-unique = !-unique } + ; isTerminal = record { ! = ¡ ; !-unique = ¡-unique } + } + where + open IsZero is-zero + +coIsZero⇒IsZero : ∀ {Z} → IsZero op Z → IsZero C Z +coIsZero⇒IsZero co-is-zero = record + { isInitial = record { ! = ! ; !-unique = !-unique } + ; isTerminal = record { ! = ¡ ; !-unique = ¡-unique } + } + where + open IsZero co-is-zero + +coZero⇒Zero : Zero op → Zero C +coZero⇒Zero zero = record + { 𝟘 = 𝟘 + ; isZero = coIsZero⇒IsZero isZero + } + where + open Zero zero + +Zero⇒coZero : Zero C → Zero op +Zero⇒coZero zero = record + { 𝟘 = 𝟘 + ; isZero = IsZero⇒coIsZero isZero + } + where + open Zero zero + +-- Tests to ensure that dualities are involutive up to definitional equality. private coIsTerminal⟺IsInitial : ∀ {X} (⊥ : IsInitial X) → coIsTerminal⇒IsInitial (IsInitial⇒coIsTerminal ⊥) ≡ ⊥ @@ -92,3 +127,19 @@ private coProduct⟺Coproduct : ∀ {A B} (p : Coproduct A B) → coProduct⇒Coproduct (Coproduct⇒coProduct p) ≡ p coProduct⟺Coproduct _ = ≡.refl + + coIsZero⟺IsZero : ∀ {Z} {zero : IsZero op Z} → + IsZero⇒coIsZero (coIsZero⇒IsZero zero) ≡ zero + coIsZero⟺IsZero = ≡.refl + + IsZero⟺coIsZero : ∀ {Z} {zero : IsZero C Z} → + coIsZero⇒IsZero (IsZero⇒coIsZero zero) ≡ zero + IsZero⟺coIsZero = ≡.refl + + coZero⟺Zero : ∀ {zero : Zero op} → + Zero⇒coZero (coZero⇒Zero zero) ≡ zero + coZero⟺Zero = ≡.refl + + Zero⟺coZero : ∀ {zero : Zero C} → + coZero⇒Zero (Zero⇒coZero zero) ≡ zero + Zero⟺coZero = ≡.refl diff --git a/src/Categories/Object/Kernel.agda b/src/Categories/Object/Kernel.agda index 7e49fddc6..ff0e8d7f3 100644 --- a/src/Categories/Object/Kernel.agda +++ b/src/Categories/Object/Kernel.agda @@ -42,7 +42,7 @@ record IsKernel {A B K} (k : K ⇒ A) (f : A ⇒ B) : Set (o ⊔ ℓ ⊔ e) wher universal-∘ : f ∘ k ∘ h ≈ zero⇒ universal-∘ {h = h} = begin f ∘ k ∘ h ≈⟨ pullˡ commute ⟩ - zero⇒ ∘ h ≈⟨ pullʳ (⟺ (¡-unique (¡ ∘ h))) ⟩ + zero⇒ ∘ h ≈⟨ zero-∘ʳ h ⟩ zero⇒ ∎ record Kernel {A B} (f : A ⇒ B) : Set (o ⊔ ℓ ⊔ e) where diff --git a/src/Categories/Object/Kernel/Properties.agda b/src/Categories/Object/Kernel/Properties.agda index 9873cce57..571132d01 100644 --- a/src/Categories/Object/Kernel/Properties.agda +++ b/src/Categories/Object/Kernel/Properties.agda @@ -27,39 +27,39 @@ private A B : Obj f : A ⇒ B --- We can express kernels as pullbacks along the morphism '! : ⊥ ⇒ A'. -Kernel⇒Pullback : Kernel f → Pullback f ! +-- We can express kernels as pullbacks along the morphism '¡ : ⊥ ⇒ A'. +Kernel⇒Pullback : Kernel f → Pullback f ¡ Kernel⇒Pullback {f = f} kernel = record { p₁ = kernel⇒ - ; p₂ = ¡ + ; p₂ = ! ; isPullback = record { commute = commute ; universal = λ {C} {h₁} {h₂} eq → universal {h = h₁} $ begin f ∘ h₁ ≈⟨ eq ⟩ - ! ∘ h₂ ≈˘⟨ refl⟩∘⟨ ¡-unique h₂ ⟩ + ¡ ∘ h₂ ≈˘⟨ refl⟩∘⟨ !-unique h₂ ⟩ zero⇒ ∎ ; unique = λ {C} {h₁} {h₂} {i} k-eq h-eq → unique $ begin h₁ ≈˘⟨ k-eq ⟩ kernel⇒ ∘ i ∎ ; p₁∘universal≈h₁ = ⟺ factors - ; p₂∘universal≈h₂ = ¡-unique₂ _ _ + ; p₂∘universal≈h₂ = !-unique₂ } } where open Kernel kernel --- All pullbacks along the morphism '! : ⊥ ⇒ A' are also kernels. -Pullback⇒Kernel : Pullback f ! → Kernel f +-- All pullbacks along the morphism '¡ : ⊥ ⇒ A' are also kernels. +Pullback⇒Kernel : Pullback f ¡ → Kernel f Pullback⇒Kernel {f = f} pullback = record { kernel⇒ = p₁ ; isKernel = record { commute = begin f ∘ p₁ ≈⟨ commute ⟩ - ! ∘ p₂ ≈˘⟨ refl⟩∘⟨ ¡-unique p₂ ⟩ + ¡ ∘ p₂ ≈˘⟨ refl⟩∘⟨ !-unique p₂ ⟩ zero⇒ ∎ ; universal = λ eq → universal eq ; factors = ⟺ p₁∘universal≈h₁ - ; unique = λ eq → unique (⟺ eq) (⟺ (¡-unique _)) + ; unique = λ eq → unique (⟺ eq) (⟺ (!-unique _)) } } where @@ -72,9 +72,9 @@ Kernel⇒Equalizer {f = f} kernel = record ; isEqualizer = record { equality = begin f ∘ kernel⇒ ≈⟨ commute ⟩ - zero⇒ ≈⟨ pushʳ (¡-unique (¡ ∘ kernel⇒)) ⟩ + zero⇒ ≈˘⟨ zero-∘ʳ kernel⇒ ⟩ zero⇒ ∘ kernel⇒ ∎ - ; equalize = λ {_} {h} eq → universal (eq ○ pullʳ (⟺ (¡-unique (¡ ∘ h)))) + ; equalize = λ {_} {h} eq → universal (eq ○ zero-∘ʳ h) ; universal = factors ; unique = unique } @@ -89,9 +89,9 @@ Equalizer⇒Kernel {f = f} equalizer = record ; isKernel = record { commute = begin f ∘ arr ≈⟨ equality ⟩ - zero⇒ ∘ arr ≈⟨ pullʳ (⟺ (¡-unique (¡ ∘ arr))) ⟩ + zero⇒ ∘ arr ≈⟨ zero-∘ʳ arr ⟩ zero⇒ ∎ - ; universal = λ {_} {h} eq → equalize (eq ○ pushʳ (¡-unique (¡ ∘ h))) + ; universal = λ {_} {h} eq → equalize (eq ○ ⟺ (zero-∘ʳ h)) ; factors = universal ; unique = unique } @@ -111,8 +111,8 @@ module _ (K : Kernel f) where module _ (has-kernels : ∀ {A B} → (f : A ⇒ B) → Kernel f) where -- The kernel of a kernel is isomorphic to the zero object. - kernel²-zero : ∀ {A B} {f : A ⇒ B} → Kernel.kernel (has-kernels (Kernel.kernel⇒ (has-kernels f))) ≅ zero - kernel²-zero {B = B} {f = f} = pullback-up-to-iso kernel-pullback (pullback-mono-mono !-Mono) + kernel²-zero : ∀ {A B} {f : A ⇒ B} → Kernel.kernel (has-kernels (Kernel.kernel⇒ (has-kernels f))) ≅ 𝟘 + kernel²-zero {B = B} {f = f} = pullback-up-to-iso kernel-pullback (pullback-mono-mono (¡-Mono 𝒞 {z = 𝒞-Zero})) where K : Kernel f K = has-kernels f @@ -122,8 +122,8 @@ module _ (has-kernels : ∀ {A B} → (f : A ⇒ B) → Kernel f) where K′ : Kernel K.kernel⇒ K′ = has-kernels K.kernel⇒ - kernel-pullback : Pullback ! ! - kernel-pullback = Pullback-resp-≈ (glue-pullback (Kernel⇒Pullback K) (swap (Kernel⇒Pullback K′))) (!-unique (f ∘ !)) refl + kernel-pullback : Pullback ¡ ¡ + kernel-pullback = Pullback-resp-≈ (glue-pullback (Kernel⇒Pullback K) (swap (Kernel⇒Pullback K′))) (¡-unique (f ∘ ¡)) refl pullback-mono-mono : ∀ {A B} {f : A ⇒ B} → Mono f → Pullback f f pullback-mono-mono mono = record diff --git a/src/Categories/Object/Zero.agda b/src/Categories/Object/Zero.agda index 1a926f3d4..5574f1d39 100644 --- a/src/Categories/Object/Zero.agda +++ b/src/Categories/Object/Zero.agda @@ -5,59 +5,56 @@ open import Categories.Category -- a zero object is both terminal and initial. module Categories.Object.Zero {o ℓ e} (C : Category o ℓ e) where -open import Level using (_⊔_) +open import Level open import Categories.Object.Terminal C open import Categories.Object.Initial C open import Categories.Morphism C +open import Categories.Morphism.Reasoning C open Category C open HomReasoning +record IsZero (Z : Obj) : Set (o ⊔ ℓ ⊔ e) where + field + isInitial : IsInitial Z + isTerminal : IsTerminal Z + + open IsInitial isInitial public + renaming + ( ! to ¡ + ; !-unique to ¡-unique + ; !-unique₂ to ¡-unique₂ + ) + open IsTerminal isTerminal public + + zero⇒ : ∀ {A B : Obj} → A ⇒ B + zero⇒ = ¡ ∘ ! + + zero-∘ˡ : ∀ {X Y Z} → (f : Y ⇒ Z) → f ∘ zero⇒ {X} ≈ zero⇒ + zero-∘ˡ f = pullˡ (⟺ (¡-unique (f ∘ ¡))) + + zero-∘ʳ : ∀ {X Y Z} → (f : X ⇒ Y) → zero⇒ {Y} {Z} ∘ f ≈ zero⇒ + zero-∘ʳ f = pullʳ (⟺ (!-unique (! ∘ f))) + record Zero : Set (o ⊔ ℓ ⊔ e) where - field - zero : Obj - ! : ∀ {A} → zero ⇒ A - ¡ : ∀ {A} → A ⇒ zero - - zero⇒ : ∀ {A B : Obj} → A ⇒ B - zero⇒ {A} = ! ∘ ¡ - - field - !-unique : ∀ {A} (f : zero ⇒ A) → ! ≈ f - ¡-unique : ∀ {A} (f : A ⇒ zero) → ¡ ≈ f - - ¡-unique₂ : ∀ {A} (f g : A ⇒ zero) → f ≈ g - ¡-unique₂ f g = ⟺ (¡-unique f) ○ ¡-unique g - - !-unique₂ : ∀ {A} (f g : zero ⇒ A) → f ≈ g - !-unique₂ f g = ⟺ (!-unique f) ○ !-unique g - - - initial : Initial - initial = record - { ⊥ = zero - ; ⊥-is-initial = record - { ! = ! - ; !-unique = !-unique - } - } - - terminal : Terminal - terminal = record - { ⊤ = zero - ; ⊤-is-terminal = record - { ! = ¡ - ; !-unique = ¡-unique - } - } - - module initial = Initial initial - module terminal = Terminal terminal - - !-Mono : ∀ {A} → Mono (! {A}) - !-Mono = from-⊤-is-Mono {t = terminal} ! - - ¡-Epi : ∀ {A} → Epi (¡ {A}) - ¡-Epi = to-⊥-is-Epi {i = initial} ¡ + field + 𝟘 : Obj + isZero : IsZero 𝟘 + + open IsZero isZero public + + terminal : Terminal + terminal = record { ⊤-is-terminal = isTerminal } + + initial : Initial + initial = record { ⊥-is-initial = isInitial } + +open Zero + +¡-Mono : ∀ {A} {z : Zero} → Mono (¡ z {A}) +¡-Mono {z = z} = from-⊤-is-Mono {t = terminal z} (¡ z) + +!-Epi : ∀ {A} {z : Zero} → Epi (! z {A}) +!-Epi {z = z} = to-⊥-is-Epi {i = initial z} (! z)