open import Cat.Instances.Shape.Terminal
open import Cat.Functor.Coherence
open import Cat.Instances.Functor
open import Cat.Prelude

import Cat.Functor.Reasoning as Func
import Cat.Reasoning as Cat

module Cat.Functor.Kan.Base where

private
  variable
    o ℓ : Level
    C C' D E : Precategory o ℓ

  cat-lvl : ∀ {o ℓ} (C : Precategory o ℓ) → Level
  cat-lvl {a} {b} _ = a ⊔ b

  kan-lvl : ∀ {o ℓ o' ℓ' o'' ℓ''} {C : Precategory o ℓ} {C' : Precategory o' ℓ'} {D : Precategory o'' ℓ''}
          → Functor C D → Functor C C' → Level
  kan-lvl {a} {b} {c} {d} {e} {f} _ _ = a ⊔ b ⊔ c ⊔ d ⊔ e ⊔ f

open _=>_

Left Kan extensions🔗

Suppose we have a functor $F : C \to D,$ and a functor $p : C \to C^{'}$ — perhaps to be thought of as a full subcategory inclusion, where $C^{'}$ is a completion of $C,$ but the situation applies just as well to any pair of functors — which naturally fit into a commutative diagram

but as we can see this is a particularly sad commutative diagram; it’s crying out for a third edge $C^{'} \to D$

extending $F$ to a functor $C^{'} \to D .$ If there exists an universal such extension (we’ll define what “universal” means in just a second), we call it the left Kan extension of $F$ along $p,$ and denote it $Lan_{p} F .$ Such extensions do not come for free (in a sense they’re pretty hard to come by), but concept of Kan extension can be used to rephrase the definition of both limit and adjoint functor.

A left Kan extension $Lan_{p} F$ is equipped with a natural transformation $η : F \Rightarrow Lan_{p} F \circ p$ witnessing the (“directed”) commutativity of the triangle (so that it need not commute on-the-nose) which is universal among such transformations; Meaning that if $M : C^{'} \to D$ is another functor with a transformation $α : F \Rightarrow M \circ p,$ there is a unique natural transformation $σ : Lan_{p} F \Rightarrow M$ which commutes with $α .$

Note that in general the triangle commutes “weakly”, but when $p$ is fully faithful and $D$ is cocomplete, $Lan_{p} F$ genuinely extends $p,$ in that $η$ is a natural isomorphism.

record
  is-lan (p : Functor C C') (F : Functor C D) (L : Functor C' D) (eta : F => L F∘ p)
    : Type (kan-lvl p F) where
  field

Universality of eta is witnessed by the following fields, which essentially say that, in the diagram below (assuming $M$ has a natural transformation $α$ witnessing the same “directed commutativity” that $η$ does for $Lan_{p} F),$ the 2-cell exists and is unique.

    σ : {M : Functor C' D} (α : F => M F∘ p) → L => M
    σ-comm : {M : Functor C' D} {α : F => M F∘ p} → (σ α ◂ p) ∘nt eta ≡ α
    σ-uniq : {M : Functor C' D} {α : F => M F∘ p} {σ' : L => M}
           → α ≡ (σ' ◂ p) ∘nt eta
           → σ α ≡ σ'

  σ-uniq₂
    : {M : Functor C' D} (α : F => M F∘ p) {σ₁' σ₂' : L => M}
    → α ≡ (σ₁' ◂ p) ∘nt eta
    → α ≡ (σ₂' ◂ p) ∘nt eta
    → σ₁' ≡ σ₂'
  σ-uniq₂ β p q = sym (σ-uniq p) ∙ σ-uniq q

  σ-uniqp
    : ∀ {M₁ M₂ : Functor C' D}
    → {α₁ : F => M₁ F∘ p} {α₂ : F => M₂ F∘ p}
    → (q : M₁ ≡ M₂)
    → PathP (λ i → F => q i F∘ p) α₁ α₂
    → PathP (λ i → L => q i) (σ α₁) (σ α₂)
  σ-uniqp q r = Nat-pathp refl q λ c' i →
    σ {M = q i} (r i) .η c'

  open _=>_ eta

We also provide a bundled form of this data.

record Lan (p : Functor C C') (F : Functor C D) : Type (kan-lvl p F) where
  field
    Ext     : Functor C' D
    eta     : F => Ext F∘ p
    has-lan : is-lan p F Ext eta

  module Ext = Func Ext
  open is-lan has-lan public

Right Kan extensions🔗

Our choice of universal property in the section above isn’t the only choice; we could instead require a terminal solution to the lifting problem, instead of an initial one. We can picture the terminal situation using the following diagram.

Note the same warnings about “weak, directed” commutativity as for left Kan extensions apply here, too. Rather than either of the triangles commuting on the nose, we have natural transformations $ε$ witnessing their commutativity.

record is-ran
  (p : Functor C C') (F : Functor C D) (Ext : Functor C' D)
  (eps : Ext F∘ p => F)
  : Type (kan-lvl p F) where
  no-eta-equality

  field
    σ : {M : Functor C' D} (α : M F∘ p => F) → M => Ext
    σ-comm : {M : Functor C' D} {β : M F∘ p => F} → eps ∘nt (σ β ◂ p) ≡ β
    σ-uniq : {M : Functor C' D} {β : M F∘ p => F} {σ' : M => Ext}
           → β ≡ eps ∘nt (σ' ◂ p)
           → σ β ≡ σ'

  open _=>_ eps renaming (η to ε)

  σ-uniq₂
    : {M : Functor C' D} (β : M F∘ p => F) {σ₁' σ₂' : M => Ext}
    → β ≡ eps ∘nt (σ₁' ◂ p)
    → β ≡ eps ∘nt (σ₂' ◂ p)
    → σ₁' ≡ σ₂'
  σ-uniq₂ β p q = sym (σ-uniq p) ∙ σ-uniq q

record Ran (p : Functor C C') (F : Functor C D) : Type (kan-lvl p F) where
  no-eta-equality
  field
    Ext     : Functor C' D
    eps     : Ext F∘ p => F
    has-ran : is-ran p F Ext eps

  module Ext = Func Ext
  open is-ran has-ran public

module _ {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eta : F => G F∘ p} where
  is-lan-is-prop : is-prop (is-lan p F G eta)
  is-lan-is-prop a b = path where
    module a = is-lan a
    module b = is-lan b

    σ≡ : {M : Functor _ _} (α : F => M F∘ p) → a.σ α ≡ b.σ α
    σ≡ α = ext (a.σ-uniq (sym b.σ-comm) ηₚ_)

    open is-lan
    path : a ≡ b
    path i .σ α = σ≡ α i
    path i .σ-comm {α = α} =
      is-prop→pathp (λ i → Nat-is-set ((σ≡ α i ◂ p) ∘nt eta) α)
        (a.σ-comm {α = α}) (b.σ-comm {α = α})
        i
    path i .σ-uniq {α = α} β =
      is-prop→pathp (λ i → Nat-is-set (σ≡ α i) _)
        (a.σ-uniq β) (b.σ-uniq β)
        i

  instance
    H-Level-is-lan : ∀ {k} → H-Level (is-lan p F G eta) (suc k)
    H-Level-is-lan = prop-instance is-lan-is-prop

module _ {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eps : G F∘ p => F} where
  is-ran-is-prop : is-prop (is-ran p F G eps)
  is-ran-is-prop a b = path where
    module a = is-ran a
    module b = is-ran b

    σ≡ : {M : Functor _ _} (α : M F∘ p => F) → a.σ α ≡ b.σ α
    σ≡ α = ext (a.σ-uniq (sym b.σ-comm) ηₚ_)

    open is-ran
    path : a ≡ b
    path i .σ α = σ≡ α i
    path i .σ-comm {β = α} =
      is-prop→pathp (λ i → Nat-is-set (eps ∘nt (σ≡ α i ◂ p)) α)
        (a.σ-comm {β = α}) (b.σ-comm {β = α})
        i
    path i .σ-uniq {β = α} γ =
      is-prop→pathp (λ i → Nat-is-set (σ≡ α i) _)
        (a.σ-uniq γ) (b.σ-uniq γ)
        i

  instance
    H-Level-is-ran : ∀ {k} → H-Level (is-ran p F G eps) (suc k)
    H-Level-is-ran = prop-instance is-ran-is-prop

Preservation and reflection of Kan extensions🔗

Let $(G : C^{'} \to D, η : F \to G \circ p)$ be the left Kan extension of $F : C \to D$ along $p : C \to C^{'},$ and suppose that $H : D \to E$ is a functor. We can “apply” $H$ to all the data of the Kan extension, obtaining the following diagram.

This looks like yet another Kan extension diagram, but it may not be universal! If this diagram is a left Kan extension, we say that $H$ preserves $(G, η) .$

module _
  {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eta : F => G F∘ p} where

  preserves-is-lan : (H : Functor D E) → is-lan p F G eta → Type _
  preserves-is-lan H _ =
    is-lan p (H F∘ F) (H F∘ G) (nat-assoc-to (H ▸ eta))

In the diagram above, the 2-cell is simply the whiskering $Hη .$ Unfortunately, proof assistants; our definition of whiskering lands in $H (Gp),$ but we require a natural transformation to $(H G) p .$

We say that a Kan extension is absolute if it is preserved by all functors out of $D .$ An important class of examples is given by adjoint functors.

  is-absolute-lan : is-lan p F G eta → Typeω
  is-absolute-lan lan =
    {o ℓ : Level} {E : Precategory o ℓ} (H : Functor D E) → preserves-is-lan H lan

module _
  {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eps : G F∘ p => F} where

We can define dual notions for right Kan extensions as well.

  preserves-is-ran : (H : Functor D E) → is-ran p F G eps → Type _
  preserves-is-ran H _ =
    is-ran p (H F∘ F) (H F∘ G) (nat-assoc-from (H ▸ eps))

  is-absolute-ran : is-ran p F G eps → Typeω
  is-absolute-ran ran =
    {o ℓ : Level} {E : Precategory o ℓ} (H : Functor D E) → preserves-is-ran H ran

module _ (p : Functor C C') (F : Functor C D) where

  preserves-lan
    : (H : Functor D E)
    → Type _
  preserves-lan H =
    ∀ {G : Functor C' D} {eta : F => G F∘ p}
    → (lan : is-lan p F G eta)
    → preserves-is-lan H lan

  preserves-ran
    : (H : Functor D E)
    → Type _
  preserves-ran H =
    ∀ {G : Functor C' D} {eps : G F∘ p => F}
    → (ran : is-ran p F G eps)
    → preserves-is-ran H ran

It may also be the case that $(H G, Hη)$ is already a Kan extension of $H F$ along $p .$ We say that $H$ reflects this Kan extension if $G, η$ is a also an extension of $F$ along $p .$

  reflects-lan
    : (H : Functor D E)
    → Type _
  reflects-lan H =
    ∀ {G : Functor C' D} {eta : F => G F∘ p}
    → is-lan p (H F∘ F) (H F∘ G) (nat-assoc-to (H ▸ eta))
    → is-lan p F G eta

  reflects-ran
    : (H : Functor D E)
    → Type _
  reflects-ran H =
    ∀ {G : Functor C' D} {eps : G F∘ p => F}
    → is-ran p (H F∘ F) (H F∘ G) (nat-assoc-from (H ▸ eps))
    → is-ran p F G eps

Lifting and creation of Kan extensions🔗

While the notions of lifted and created limits are commonplace in the literature on category theory, their evident generalisations to Kan extensions are less often encountered. We define those here, but refer the reader to the page about limits for more details.

module _ (H : Functor D E) {p : Functor C C'} {F : Functor C D} where

Given a Kan extension of $H \circ F$ along $p,$ we say that $H$ lifts this extension if there is a Kan extension of $F$ along $p$ that is preserved by $H .$

  record lifts-lan (lan : Lan p (H F∘ F)) : Type (kan-lvl p F ⊔ cat-lvl E) where
    no-eta-equality
    field
      lifted : Lan p F
      preserved : preserves-is-lan H (Lan.has-lan lifted)

  record lifts-ran (ran : Ran p (H F∘ F)) : Type (kan-lvl p F ⊔ cat-lvl E) where
    no-eta-equality
    field
      lifted : Ran p F
      preserved : preserves-is-ran H (Ran.has-ran lifted)

module _ (H : Functor D E) (p : Functor C C') (F : Functor C D) where

We say that $H$ creates Kan extensions of $F$ along $p$ if it lifts them and reflects them.

  record creates-lan : Type (kan-lvl p F ⊔ cat-lvl E) where
    no-eta-equality
    field
      has-lifts-lan : (lan : Lan p (H F∘ F)) → lifts-lan H lan
      reflects : reflects-lan p F H

  record creates-ran : Type (kan-lvl p F ⊔ cat-lvl E) where
    no-eta-equality
    field
      has-lifts-ran : (ran : Ran p (H F∘ F)) → lifts-ran H ran
      reflects : reflects-ran p F H

module _ (p : Functor C C') (H : Functor D E) where

  lifts-lan-along : Type _
  lifts-lan-along =
    ∀ {F : Functor C D} (lan : Lan p (H F∘ F))
    → lifts-lan H lan

  creates-lan-along : Type _
  creates-lan-along =
    ∀ {F : Functor C D}
    → creates-lan H p F

  lifts-ran-along : Type _
  lifts-ran-along =
    ∀ {F : Functor C D} (ran : Ran p (H F∘ F))
    → lifts-ran H ran

  creates-ran-along : Type _
  creates-ran-along =
    ∀ {F : Functor C D}
    → creates-ran H p F

to-ran
  : ∀ {p : Functor C C'} {F : Functor C D} {L : Functor C' D} {eps : L F∘ p => F}
  → is-ran p F L eps
  → Ran p F
to-ran {L = L} ran .Ran.Ext = L
to-ran {eps = eps} ran .Ran.eps = eps
to-ran ran .Ran.has-ran = ran

to-lan
  : ∀ {p : Functor C C'} {F : Functor C D} {L : Functor C' D} {eta : F => L F∘ p}
  → is-lan p F L eta
  → Lan p F
to-lan {L = L} lan .Lan.Ext = L
to-lan {eta = eta} lan .Lan.eta = eta
to-lan lan .Lan.has-lan = lan