diff --git a/src/Cat.agda b/src/Cat.agda index 4cb7bb8..edf98de 100644 --- a/src/Cat.agda +++ b/src/Cat.agda @@ -3,10 +3,15 @@ module Cat where import Cat.Category import Cat.Functor import Cat.CwF +import Cat.CartesianClosed +import Cat.Exponential +import Cat.Product + import Cat.Category.Pathy import Cat.Category.Bij import Cat.Category.Free import Cat.Category.Properties + import Cat.Categories.Sets -- import Cat.Categories.Cat import Cat.Categories.Rel diff --git a/src/Cat/CartesianClosed.agda b/src/Cat/CartesianClosed.agda new file mode 100644 index 0000000..e00fd0d --- /dev/null +++ b/src/Cat/CartesianClosed.agda @@ -0,0 +1,12 @@ +module Cat.CartesianClosed where + +open import Agda.Primitive + +open import Cat.Category +open import Cat.Product +open import Cat.Exponential + +record CartesianClosed {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where + field + {{hasProducts}} : HasProducts ℂ + {{hasExponentials}} : HasExponentials ℂ diff --git a/src/Cat/Categories/Sets.agda b/src/Cat/Categories/Sets.agda index 259ec44..1bc747d 100644 --- a/src/Cat/Categories/Sets.agda +++ b/src/Cat/Categories/Sets.agda @@ -8,6 +8,7 @@ import Function open import Cat.Category open import Cat.Functor +open import Cat.Product open Category module _ {ℓ : Level} where diff --git a/src/Cat/Category.agda b/src/Cat/Category.agda index bdb632c..036a3e4 100644 --- a/src/Cat/Category.agda +++ b/src/Cat/Category.agda @@ -136,49 +136,6 @@ module Category {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where open Category using ( Object ; _[_,_] ; _[_∘_]) --- open RawCategory - -module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Object ℂ} where - IsProduct : (π₁ : ℂ [ obj , A ]) (π₂ : ℂ [ obj , B ]) → Set (ℓ ⊔ ℓ') - IsProduct π₁ π₂ - = ∀ {X : Object ℂ} (x₁ : ℂ [ X , A ]) (x₂ : ℂ [ X , B ]) - → ∃![ x ] (ℂ [ π₁ ∘ x ] ≡ x₁ × ℂ [ π₂ ∘ x ] ≡ x₂) - --- Tip from Andrea; Consider this style for efficiency: --- record IsProduct {ℓ ℓ' : Level} (ℂ : Category {ℓ} {ℓ'}) --- {A B obj : Object ℂ} (π₁ : Arrow ℂ obj A) (π₂ : Arrow ℂ obj B) : Set (ℓ ⊔ ℓ') where --- field --- isProduct : ∀ {X : ℂ .Object} (x₁ : ℂ .Arrow X A) (x₂ : ℂ .Arrow X B) --- → ∃![ x ] (ℂ ._⊕_ π₁ x ≡ x₁ × ℂ. _⊕_ π₂ x ≡ x₂) - -record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : Object ℂ) : Set (ℓ ⊔ ℓ') where - no-eta-equality - field - obj : Object ℂ - proj₁ : ℂ [ obj , A ] - proj₂ : ℂ [ obj , B ] - {{isProduct}} : IsProduct ℂ proj₁ proj₂ - - arrowProduct : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ]) - → ℂ [ X , obj ] - arrowProduct π₁ π₂ = fst (isProduct π₁ π₂) - -record HasProducts {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where - field - product : ∀ (A B : Object ℂ) → Product {ℂ = ℂ} A B - - open Product - - objectProduct : (A B : Object ℂ) → Object ℂ - objectProduct A B = Product.obj (product A B) - -- The product mentioned in awodey in Def 6.1 is not the regular product of arrows. - -- It's a "parallel" product - parallelProduct : {A A' B B' : Object ℂ} → ℂ [ A , A' ] → ℂ [ B , B' ] - → ℂ [ objectProduct A B , objectProduct A' B' ] - parallelProduct {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B') - (ℂ [ a ∘ (product A B) .proj₁ ]) - (ℂ [ b ∘ (product A B) .proj₂ ]) - module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where private open Category ℂ @@ -212,40 +169,6 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where -- assoc (Opposite-is-involution i) = {!!} -- ident (Opposite-is-involution i) = {!!} -module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where - open HasProducts hasProducts - open Product hiding (obj) - private - _×p_ : (A B : Object ℂ) → Object ℂ - _×p_ A B = Product.obj (product A B) - - module _ (B C : Object ℂ) where - IsExponential : (Cᴮ : Object ℂ) → ℂ [ Cᴮ ×p B , C ] → Set (ℓ ⊔ ℓ') - IsExponential Cᴮ eval = ∀ (A : Object ℂ) (f : ℂ [ A ×p B , C ]) - → ∃![ f~ ] (ℂ [ eval ∘ parallelProduct f~ (Category.𝟙 ℂ)] ≡ f) - - record Exponential : Set (ℓ ⊔ ℓ') where - field - -- obj ≡ Cᴮ - obj : Object ℂ - eval : ℂ [ obj ×p B , C ] - {{isExponential}} : IsExponential obj eval - -- If I make this an instance-argument then the instance resolution - -- algorithm goes into an infinite loop. Why? - exponentialsHaveProducts : HasProducts ℂ - exponentialsHaveProducts = hasProducts - transpose : (A : Object ℂ) → ℂ [ A ×p B , C ] → ℂ [ A , obj ] - transpose A f = fst (isExponential A f) - -record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where - field - exponent : (A B : Object ℂ) → Exponential ℂ A B - -record CartesianClosed {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where - field - {{hasProducts}} : HasProducts ℂ - {{hasExponentials}} : HasExponentials ℂ - module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where unique = isContr diff --git a/src/Cat/Exponential.agda b/src/Cat/Exponential.agda new file mode 100644 index 0000000..df70399 --- /dev/null +++ b/src/Cat/Exponential.agda @@ -0,0 +1,39 @@ +module Cat.Exponential where + +open import Agda.Primitive +open import Data.Product +open import Cubical + +open import Cat.Category +open import Cat.Product + +open Category + +module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} where + open HasProducts hasProducts + open Product hiding (obj) + private + _×p_ : (A B : Object ℂ) → Object ℂ + _×p_ A B = Product.obj (product A B) + + module _ (B C : Object ℂ) where + IsExponential : (Cᴮ : Object ℂ) → ℂ [ Cᴮ ×p B , C ] → Set (ℓ ⊔ ℓ') + IsExponential Cᴮ eval = ∀ (A : Object ℂ) (f : ℂ [ A ×p B , C ]) + → ∃![ f~ ] (ℂ [ eval ∘ parallelProduct f~ (Category.𝟙 ℂ)] ≡ f) + + record Exponential : Set (ℓ ⊔ ℓ') where + field + -- obj ≡ Cᴮ + obj : Object ℂ + eval : ℂ [ obj ×p B , C ] + {{isExponential}} : IsExponential obj eval + -- If I make this an instance-argument then the instance resolution + -- algorithm goes into an infinite loop. Why? + exponentialsHaveProducts : HasProducts ℂ + exponentialsHaveProducts = hasProducts + transpose : (A : Object ℂ) → ℂ [ A ×p B , C ] → ℂ [ A , obj ] + transpose A f = proj₁ (isExponential A f) + +record HasExponentials {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {{_ : HasProducts ℂ}} : Set (ℓ ⊔ ℓ') where + field + exponent : (A B : Object ℂ) → Exponential ℂ A B diff --git a/src/Cat/Product.agda b/src/Cat/Product.agda new file mode 100644 index 0000000..f50c36d --- /dev/null +++ b/src/Cat/Product.agda @@ -0,0 +1,50 @@ +module Cat.Product where + +open import Agda.Primitive +open import Data.Product +open import Cubical + +open import Cat.Category + +open Category + +module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') {A B obj : Object ℂ} where + IsProduct : (π₁ : ℂ [ obj , A ]) (π₂ : ℂ [ obj , B ]) → Set (ℓ ⊔ ℓ') + IsProduct π₁ π₂ + = ∀ {X : Object ℂ} (x₁ : ℂ [ X , A ]) (x₂ : ℂ [ X , B ]) + → ∃![ x ] (ℂ [ π₁ ∘ x ] ≡ x₁ × ℂ [ π₂ ∘ x ] ≡ x₂) + +-- Tip from Andrea; Consider this style for efficiency: +-- record IsProduct {ℓ ℓ' : Level} (ℂ : Category {ℓ} {ℓ'}) +-- {A B obj : Object ℂ} (π₁ : Arrow ℂ obj A) (π₂ : Arrow ℂ obj B) : Set (ℓ ⊔ ℓ') where +-- field +-- isProduct : ∀ {X : ℂ .Object} (x₁ : ℂ .Arrow X A) (x₂ : ℂ .Arrow X B) +-- → ∃![ x ] (ℂ ._⊕_ π₁ x ≡ x₁ × ℂ. _⊕_ π₂ x ≡ x₂) + +record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : Object ℂ) : Set (ℓ ⊔ ℓ') where + no-eta-equality + field + obj : Object ℂ + proj₁ : ℂ [ obj , A ] + proj₂ : ℂ [ obj , B ] + {{isProduct}} : IsProduct ℂ proj₁ proj₂ + + arrowProduct : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ]) + → ℂ [ X , obj ] + arrowProduct π₁ π₂ = proj₁ (isProduct π₁ π₂) + +record HasProducts {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where + field + product : ∀ (A B : Object ℂ) → Product {ℂ = ℂ} A B + + open Product + + objectProduct : (A B : Object ℂ) → Object ℂ + objectProduct A B = Product.obj (product A B) + -- The product mentioned in awodey in Def 6.1 is not the regular product of arrows. + -- It's a "parallel" product + parallelProduct : {A A' B B' : Object ℂ} → ℂ [ A , A' ] → ℂ [ B , B' ] + → ℂ [ objectProduct A B , objectProduct A' B' ] + parallelProduct {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B') + (ℂ [ a ∘ (product A B) .proj₁ ]) + (ℂ [ b ∘ (product A B) .proj₂ ])