open import Cat.Instances.Functor
open import Cat.Instances.Product
open import Cat.Instances.Sets
open import Cat.Diagram.Coend
open import Cat.Prelude

open import Data.Set.Coequaliser

module Cat.Diagram.Coend.Sets where

Coends in SetsπŸ”—

We can give an explicit construction of coends in the category of sets by taking a [coequaliser]. Intuitively, the coend should be the β€œsum of the diagonal” of a functor CopΓ—Cβ†’Sets\mathcal{C}{^{{\mathrm{op}}}}\times \mathcal{C} \to {{\mathbf{Sets}}}, which translates directly to the sigma type Ξ£[ X ∈ Ob ] ∣ Fβ‚€ (X , X) ∣. However, trying to use this without some sort of quotient is going to be immediately problematic. For starters, this isn’t even a set! More importantly, we run into an immediate issue when we try to prove that this is extranatural; we need to show that F₁ (f , id) Fyx ≑ F₁ (id , f) Fyx for all f : Hom Y X and ∣ Fyx : Fβ‚€ (X , Y) ∣.

However, if we take a [coequaliser] of Ξ£[ X ∈ Ob ] ∣ Fβ‚€ (X , X) ∣ both of these problems immediately disappear. In particular, we want to take the coequaliser of the following pair of functions:

[coequaliser] Data.Set.Coequaliser.html

This allows us to prove the troublesome extranaturality condition directly with glue. With that motivation out of the way, let’s continue with the construction!

module _ {o β„“} {C : Precategory o β„“} (F : Functor (C ^op Γ—αΆœ C) (Sets (o βŠ” β„“))) where

  open Precategory C
  open Functor F
  open Coend
  open Cowedge

We start by defining the two maps we will coequalise along. Quite a bit of bundling is required to make things well typed, but this is exactly the same pair of maps in the diagram above.

  dimapl : Ξ£[ X ∈ Ob ] Ξ£[ Y ∈ Ob ] Ξ£[ f ∈ Hom Y X ] ∣ Fβ‚€ (X , Y) ∣
         β†’ Ξ£[ X ∈ Ob ] ∣ Fβ‚€ (X , X) ∣
  dimapl (X , Y , f , Fxy) = X , (F₁ (id , f) Fxy)

  dimapr : Ξ£[ X ∈ Ob ] Ξ£[ Y ∈ Ob ] Ξ£[ f ∈ Hom Y X ] ∣ Fβ‚€ (X , Y) ∣
         β†’ Ξ£[ X ∈ Ob ] ∣ Fβ‚€ (X , X) ∣
  dimapr (X , Y , f , Fxy) = Y , (F₁ (f , id) Fxy)

Constructing the universal Cowedge is easy now that we’ve taken the right coequaliser.

  Set-coend : Coend F
  Set-coend = coend where

    universal-cowedge : Cowedge F
    universal-cowedge .nadir = el! (Coeq dimapl dimapr)
    universal-cowedge .ψ X Fxx = inc (X , Fxx)
    universal-cowedge .extranatural {X} {Y} f =
     funext Ξ» Fyx β†’ glue (Y , X , f , Fyx)

To show that the Cowedge is universal, we can essentially just project out the bundled up object from the coend and feed that to the family associated to the cowedge W.

    coend : Coend F
    coend .cowedge = universal-cowedge
    coend .factor W =
      Coeq-rec hlevel! (Ξ» ∫F β†’ W .ψ (∫F .fst) (∫F .snd)) Ξ» where
        (X , Y , f , Fxy) β†’ happly (W .extranatural f) Fxy
    coend .commutes = refl
    coend .unique {W = W} p =
      funext $ Coeq-elim hlevel! (Ξ» ∫F β†’ happly p (∫F .snd)) Ξ» where
        (X , Y , f , Fxy) → is-set→squarep (λ _ _ → is-tr (W .nadir)) _ _ _ _

This construction is actually functorial! Given any functor Cop×C→Sets\mathcal{C}{^{{\mathrm{op}}}}\times \mathcal{C} \to {{\mathbf{Sets}}}, we can naturally construct its Coend in Sets{{\mathbf{Sets}}}. This ends up assembling into a functor from the functor category [Cop×C,Sets][ \mathcal{C}{^{{\mathrm{op}}}}\times \mathcal{C} , {{\mathbf{Sets}}}] into Sets{{\mathbf{Sets}}}.

module _ {o β„“} {π’ž : Precategory o β„“} where
  open Precategory π’ž
  open Functor
  open _=>_

  Coends : Functor Cat[ π’ž ^op Γ—αΆœ π’ž , Sets (o βŠ” β„“) ] (Sets (o βŠ” β„“))
  Coends .Fβ‚€ F = el! (Coeq (dimapl F) (dimapr F))
  Coends .F₁ Ξ± =
    Coeq-rec squash (Ξ» ∫F β†’ inc ((∫F .fst) , Ξ± .Ξ· _ (∫F .snd))) Ξ» where
      (X , Y , f , Fxy) β†’
        (ap (Ξ» Ο• β†’ inc (X , Ο•)) $ happly (Ξ± .is-natural (X , Y) (X , X) (id , f)) Fxy) Β·Β·
        glue (X , Y , f , Ξ± .Ξ· (X , Y) Fxy) Β·Β·
        (sym $ ap (Ξ» Ο• β†’ inc (Y , Ο•)) $ happly (Ξ± .is-natural (X , Y) (Y , Y) (f , id)) Fxy)
  Coends .F-id =
    funext $ Coeq-elim
      (Ξ» _ β†’ hlevel!)
      (Ξ» _ β†’ refl)
      (λ _ → is-set→squarep (λ _ _ → squash) _ _ _ _)
  Coends .F-∘ f g =
    funext $ Coeq-elim
      (Ξ» _ β†’ hlevel!)
      (Ξ» _ β†’ refl)
      (λ _ → is-set→squarep (λ _ _ → squash) _ _ _ _)