module Cat.Functor.Kan.Unique where
Uniqueness of Kan extensionsð
Kan extensions (both left and right) are universal constructions, so they are unique when they exist. To get a theorem out of this intuition, we must be careful about how the structure and the properties are separated: Informally, we refer to the functor as âthe Kan extensionâ, but in reality, the data associated with âthe Kan extension of along â also includes the natural transformation. For accuracy, using the setup from the diagram below, we should say â is the Kan extension of along â.
private variable o â : Level C C' D : Precategory o â module Lan-unique {p : Functor C C'} {F : Functor C D} {Gâ Gâ : Functor C' D} {ηâ ηâ} (lâ : is-lan p F Gâ ηâ) (lâ : is-lan p F Gâ ηâ) where private module lâ = is-lan lâ module lâ = is-lan lâ module D = Cat.Reasoning D module C'D = Cat.Reasoning Cat[ C' , D ] open C'D._â _ open C'D.Inverses
To show uniqueness, suppose that and and both left extensions of along Diagramming this with both natural transformations shown is a bit of a nightmare: the option which doesnât result in awful crossed arrows is to duplicate the span So, to be clear: The upper triangle and the lower triangle are the same.
Recall that being a left extension means we can (uniquely) factor natural transformations through transformations We want a map for which it will suffice to find a map â but is right there! In the other direction, we can factor to get a map Since these factorisations are unique, we have a natural isomorphism.
Ï-inversesp : â {α : Gâ => Gâ} {β : Gâ => Gâ} â (α â p) ânt ηâ ⡠ηâ â (β â p) ânt ηâ ⡠ηâ â Inverses⿠α β Ï-inversesp α-factor β-factor = C'D.make-inverses (lâ.Ï-uniqâ ηâ (ext λ j â sym (D.pullr (β-factor ηâ j) â α-factor ηâ j)) (ext λ j â sym (D.idl _))) (lâ.Ï-uniqâ ηâ (ext λ j â sym (D.pullr (α-factor ηâ j) â β-factor ηâ j)) (ext λ j â sym (D.idl _)))
Ï-is-invertiblep : â {α : Gâ => Gâ} â (α â p) ânt ηâ ⡠ηâ â is-invertible⿠α Ï-is-invertiblep {α = α} α-factor = C'D.inversesâinvertible (Ï-inversesp {α} α-factor lâ.Ï-comm) Ï-inverses : Inversesâ¿ (lâ.Ï Î·â) (lâ.Ï Î·â) Ï-inverses = Ï-inversesp lâ.Ï-comm lâ.Ï-comm Ï-is-invertible : is-invertibleâ¿ (lâ.Ï Î·â) Ï-is-invertible = Ï-is-invertiblep lâ.Ï-comm unique : Gâ â â¿ Gâ unique = C'D.invertibleâiso (lâ.Ï Î·â) (Ï-is-invertiblep lâ.Ï-comm)
Itâs immediate from the construction that this isomorphism âsends to â.
unit : (lâ.Ï Î·â â p) ânt ηâ ⡠ηâ unit = lâ.Ï-comm
module _ {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eta} (lan : is-lan p F G eta) where private module lan = is-lan lan module D = Cat.Reasoning D module C'D = Cat.Reasoning Cat[ C' , D ] open _=>_
Another uniqueness-like result we can state for left extensions is the following: Given any functor and candidate âunitâ transformation if a left extension sends to a natural isomorphism, then is also a left extension of along
is-invertibleâis-lan : â {G' : Functor C' D} {eta' : F => G' Fâ p} â is-invertibleâ¿ (lan.Ï eta') â is-lan p F G' eta' is-invertibleâis-lan {G' = G'} {eta'} invert = lan' where open is-lan open C'D.is-invertible invert lan' : is-lan p F G' eta' lan' .Ï Î± = lan.Ï Î± ânt inv lan' .Ï-comm {M} {α} = ext λ j â (lan.Ï Î± .η _ D.â inv .η _) D.â eta' .η j â¡Ëâš D.reflâ©ââš (lan.Ï-comm ηâ _) â©â¡Ë (lan.Ï Î± .η _ D.â inv .η _) D.â (lan.Ï eta' .η _ D.â eta .η j) â¡âš D.cancel-inner (invr ηâ _) â©â¡ lan.Ï Î± .η _ D.â eta .η j â¡âš lan.Ï-comm ηâ _ â©â¡ α .η j â lan' .Ï-uniq {M} {α} {Ï'} p = ext λ j â lan.Ï Î± .η j D.â inv .η j â¡âš (lan.Ï-uniq {Ï' = Ï' ânt lan.Ï eta'} (ext λ j â p ηâ j â D.pushr (sym (lan.Ï-comm ηâ j))) ηâ j) D.â©ââšrefl â©â¡ (Ï' .η j D.â lan.Ï eta' .η j) D.â inv .η _ â¡âš D.cancelr (invl ηâ _) â©â¡ Ï' .η j â
natural-iso-ofâis-lan : {F' : Functor C D} â (isos : F â â¿ F') â is-lan p F' G (eta ânt Isoâ¿.from isos) natural-iso-ofâis-lan {F' = F'} isos = lan' where open is-lan module isos = Isoâ¿ isos lan' : is-lan p F' G (eta ânt isos.from) lan' .Ï Î± = lan.Ï (α ânt isos.to) lan' .Ï-comm {M} {α} = ext λ j â lan.Ï (α ânt isos.to) .η _ D.â eta .η j D.â isos.from .η j â¡âš D.pulll (lan.Ï-comm ηâ j) â©â¡ (α .η j D.â isos.to .η j) D.â isos.from .η j â¡âš D.cancelr (isos.invl ηâ _) â©â¡ α .η j â lan' .Ï-uniq {M} {α} {Ï'} p = lan.Ï-uniq $ ext λ j â α .η j D.â isos.to .η j â¡âš (p ηâ j) D.â©ââšrefl â©â¡ (Ï' .η _ D.â eta .η j D.â isos.from .η j) D.â isos.to .η j â¡âš D.deleter (isos.invr ηâ _) â©â¡ Ï' .η _ D.â eta .η j â natural-iso-extâis-lan : {G' : Functor C' D} â (isos : G â â¿ G') â is-lan p F G' ((Isoâ¿.to isos â p) ânt eta) natural-iso-extâis-lan {G' = G'} isos = lan' where open is-lan module isos = Isoâ¿ isos lan' : is-lan p F G' ((isos.to â p) ânt eta) lan' .Ï Î± = lan.Ï Î± ânt isos.from lan' .Ï-comm {M} {α} = ext λ j â (lan.Ï Î± .η _ D.â isos.from .η _) D.â isos.to .η _ D.â eta .η j â¡âš D.cancel-inner (isos.invr ηâ _) â©â¡ lan.Ï Î± .η _ D.â eta .η j â¡âš lan.Ï-comm ηâ _ â©â¡ α .η j â lan' .Ï-uniq {M} {α} {Ï'} p = ext λ j â lan.Ï Î± .η j D.â isos.from .η j â¡âš D.pushl (lan.Ï-uniq {Ï' = Ï' ânt isos.to} (ext λ j â p ηâ j â D.assoc _ _ _) ηâ j) â©â¡ Ï' .η j D.â isos.to .η j D.â isos.from .η j â¡âš D.elimr (isos.invl ηâ _) â©â¡ Ï' .η j â natural-iso-alongâis-lan : {p' : Functor C C'} â (isos : p â â¿ p') â is-lan p' F G ((G âž Isoâ¿.to isos) ânt eta) natural-iso-alongâis-lan {p'} isos = lan' where open is-lan module isos = Isoâ¿ isos open Cat.Functor.Reasoning lan' : is-lan p' F G ((G âž Isoâ¿.to isos) ânt eta) lan' .Ï {M} α = lan.Ï ((M âž isos.from) ânt α) lan' .Ï-comm {M = M} = ext λ j â D.pulll ((lan.Ï _ .is-natural _ _ _)) â D.pullr (lan.Ï-comm ηâ _) â cancell M (isos.invl ηâ _) lan' .Ï-uniq {M = M} {α = α} {Ï' = Ï'} q = ext λ c' â lan.Ï-uniq {α = (M âž isos.from) ânt α} {Ï' = Ï'} (ext λ j â D.pushr (q ηâ _) â D.pulll ( D.pullr (Ï' .is-natural _ _ _) â cancell M (isos.invr ηâ _))) ηâ c' universal-pathâis-lan : â {eta'} â eta â¡ eta' â is-lan p F G eta' universal-pathâis-lan {eta'} q = lan' where open is-lan lan' : is-lan p F G eta' lan' .Ï = lan.Ï lan' .Ï-comm = ap (_ ânt_) (sym q) â lan.Ï-comm lan' .Ï-uniq r = lan.Ï-uniq (r â ap (_ ânt_) (sym q)) module _ {p p' : Functor C C'} {F F' : Functor C D} {G G' : Functor C' D} {eps eps'} where private module D = Cat.Reasoning D open Cat.Functor.Reasoning open _=>_
Left Kan extensions are also invariant under arbitrary natural isomorphisms. To get better definitional control, we allow âadjustingâ the resulting construction to talk about any natural transformation which is propositionally equal to the whiskering:
natural-isosâis-lan : (p-iso : p â â¿ p') â (F-iso : F â â¿ F') â (G-iso : G â â¿ G') â ((Isoâ¿.to G-iso â Isoâ¿.to p-iso) ânt eps ânt Isoâ¿.from F-iso) â¡ eps' â is-lan p F G eps â is-lan p' F' G' eps'
natural-isosâis-lan p-iso F-iso G-iso q lan = universal-pathâis-lan (natural-iso-extâis-lan (natural-iso-ofâis-lan (natural-iso-alongâis-lan lan p-iso) F-iso) G-iso) (ext λ x â D.extendl (D.pulll (G-iso .to .is-natural _ _ _)) â q ηâ _) where open Isoâ¿
Into univalent categoriesð
As traditional with universal constructions, if takes values in a univalent category, we can sharpen our result: the type of left extensions of along is a proposition.
Lan-is-prop : â {p : Functor C C'} {F : Functor C D} â is-category D â is-prop (Lan p F) Lan-is-prop {C = C} {C' = C'} {D = D} {p = p} {F = F} d-cat Lâ Lâ = path where
module Lâ = Lan Lâ module Lâ = Lan Lâ module Lu = Lan-unique Lâ.has-lan Lâ.has-lan open Lan c'd-cat : is-category Cat[ C' , D ] c'd-cat = Functor-is-category d-cat
Thatâs because if is univalent, then so is , so our natural isomorphism is equivalent to an identification Then, our tiny lemma stating that this isomorphism âsends to â is precisely the data of a dependent identification over
functor-path : Lâ.Ext â¡ Lâ.Ext functor-path = c'd-cat .to-path Lu.unique eta-path : PathP (λ i â F => functor-path i Fâ p) Lâ.eta Lâ.eta eta-path = Nat-pathp _ _ λ x â Univalent.Hom-pathp-reflr-iso d-cat (Lu.unit ηâ _)
Since being a left extension is always a proposition when applied to even when the categories are not univalent, we can finish our proof.
path : Lâ â¡ Lâ path i .Ext = functor-path i path i .eta = eta-path i path i .has-lan = is-propâpathp (λ i â is-lan-is-prop {p = p} {F} {functor-path i} {eta-path i}) Lâ.has-lan Lâ.has-lan i
module Ran-unique {p : Functor C C'} {F : Functor C D} {Gâ Gâ : Functor C' D} {εâ εâ} (râ : is-ran p F Gâ εâ) (râ : is-ran p F Gâ εâ) where private module râ = is-ran râ module râ = is-ran râ module D = Cat.Reasoning D module C'D = Cat.Reasoning Cat[ C' , D ] open C'D._â _ open C'D.Inverses Ï-inversesp : â {α : Gâ => Gâ} {β : Gâ => Gâ} â (εâ ânt (α â p)) ⡠εâ â (εâ ânt (β â p)) ⡠εâ â Inverses⿠α β Ï-inversesp α-factor β-factor = C'D.make-inverses (râ.Ï-uniqâ εâ (ext λ j â sym (D.pulll (α-factor ηâ j) â β-factor ηâ j)) (ext λ j â sym (D.idr _))) (râ.Ï-uniqâ εâ (ext λ j â sym (D.pulll (β-factor ηâ j) â α-factor ηâ j)) (ext λ j â sym (D.idr _))) Ï-is-invertiblep : â {α : Gâ => Gâ} â (εâ ânt (α â p)) ⡠εâ â is-invertible⿠α Ï-is-invertiblep {α} α-factor = C'D.inversesâinvertible (Ï-inversesp {α} α-factor râ.Ï-comm) Ï-inverses : Inversesâ¿ (râ.Ï Îµâ) (râ.Ï Îµâ) Ï-inverses = Ï-inversesp râ.Ï-comm râ.Ï-comm Ï-is-invertible : is-invertibleâ¿ (râ.Ï Îµâ) Ï-is-invertible = Ï-is-invertiblep râ.Ï-comm unique : Gâ â â¿ Gâ unique = C'D.invertibleâiso (râ.Ï Îµâ) (Ï-is-invertiblep râ.Ï-comm) niâ»Â¹ counit : εâ ânt (râ.Ï Îµâ â p) ⡠εâ counit = râ.Ï-comm module _ {p : Functor C C'} {F : Functor C D} {G : Functor C' D} {eps} (ran : is-ran p F G eps) where private module ran = is-ran ran module D = Cat.Reasoning D module C'D = Cat.Reasoning Cat[ C' , D ] open _=>_ -- These are more annoying to do via duality then it is to do by hand, -- due to the natural isos. is-invertibleâis-ran : â {G' : Functor C' D} {eps'} â is-invertibleâ¿ (ran.Ï eps') â is-ran p F G' eps' is-invertibleâis-ran {G' = G'} {eps'} invert = ran' where open is-ran open C'D.is-invertible invert ran' : is-ran p F G' eps' ran' .Ï Î² = inv ânt ran.Ï Î² ran' .Ï-comm {M} {β} = ext λ j â sym ((ran.Ï-comm ηâ _) D.â©ââšrefl) ·· D.cancel-inner (invl ηâ _) ·· (ran.Ï-comm ηâ _) ran' .Ï-uniq {M} {β} {Ï'} p = ext λ j â (D.reflâ©ââš ran.Ï-uniq {Ï' = ran.Ï eps' ânt Ï'} (ext λ j â p ηâ j â D.pushl (sym (ran.Ï-comm ηâ j))) ηâ _) â D.cancell (invr ηâ _) natural-iso-ofâis-ran : {F' : Functor C D} â (isos : F â â¿ F') â is-ran p F' G (Isoâ¿.to isos ânt eps) natural-iso-ofâis-ran {F'} isos = ran' where open is-ran module isos = Isoâ¿ isos ran' : is-ran p F' G (isos.to ânt eps) ran' .Ï Î² = ran.Ï (isos.from ânt β) ran' .Ï-comm {M} {β} = ext λ j â D.pullr (ran.Ï-comm ηâ j) â D.cancell (isos.invl ηâ _) ran' .Ï-uniq {M} {β} {Ï'} p = ran.Ï-uniq $ ext λ j â (D.reflâ©ââš p ηâ j) â D.deletel (isos.invr ηâ _) natural-iso-extâis-ran : {G' : Functor C' D} â (isos : G â â¿ G') â is-ran p F G' (eps ânt (Isoâ¿.from isos â p)) natural-iso-extâis-ran {G'} isos = ran' where open is-ran module isos = Isoâ¿ isos ran' : is-ran p F G' (eps ânt (isos.from â p)) ran' .Ï Î² = isos.to ânt ran.Ï Î² ran' .Ï-comm {M} {β} = ext λ j â D.cancel-inner (isos.invr ηâ _) â ran.Ï-comm ηâ _ ran' .Ï-uniq {M} {β} {Ï'} p = ext λ j â D.pushr (ran.Ï-uniq {Ï' = isos.from ânt Ï'} (ext λ j â p ηâ j â sym (D.assoc _ _ _)) ηâ j) â D.eliml (isos.invl ηâ _) natural-iso-alongâis-ran : {p' : Functor C C'} â (isos : p â â¿ p') â is-ran p' F G (eps ânt (G âž Isoâ¿.from isos)) natural-iso-alongâis-ran {p'} isos = ran' where open is-ran module isos = Isoâ¿ isos open Cat.Functor.Reasoning ran' : is-ran p' F G (eps ânt (G âž Isoâ¿.from isos)) ran' .Ï {M} β = ran.Ï (β ânt (M âž Isoâ¿.to isos)) ran' .Ï-comm {M = M} = ext λ j â D.pullr (sym (ran.Ï _ .is-natural _ _ _)) â D.pulll (ran.Ï-comm ηâ _) â cancelr M (isos.invl ηâ _) ran' .Ï-uniq {M = M} {β = β} {Ï' = Ï'} q = ext λ c' â ran.Ï-uniq {β = β ânt (M âž isos.to)} {Ï' = Ï'} (ext λ j â D.pushl (q ηâ _) â D.pullr ( D.pulll (sym (Ï' .is-natural _ _ _)) â cancelr M (isos.invr ηâ _))) ηâ c' universal-pathâis-ran : â {eps'} â eps â¡ eps' â is-ran p F G eps' universal-pathâis-ran {eps'} q = ran' where open is-ran ran' : is-ran p F G eps' ran' .Ï = ran.Ï ran' .Ï-comm = ap (_ânt _) (sym q) â ran.Ï-comm ran' .Ï-uniq r = ran.Ï-uniq (r â ap (_ânt _) (sym q)) module _ {p p' : Functor C C'} {F F' : Functor C D} {G G' : Functor C' D} {eps eps'} where private module D = Cat.Reasoning D open _=>_ natural-isosâis-ran : (p-iso : p â â¿ p') â (F-iso : F â â¿ F') â (G-iso : G â â¿ G') â (Isoâ¿.to F-iso ânt eps ânt (Isoâ¿.from G-iso â Isoâ¿.from p-iso)) â¡ eps' â is-ran p F G eps â is-ran p' F' G' eps' natural-isosâis-ran p-iso F-iso G-iso p ran = universal-pathâis-ran (natural-iso-extâis-ran (natural-iso-ofâis-ran (natural-iso-alongâis-ran ran p-iso) F-iso) G-iso) (ext λ c â sym (D.assoc _ _ _) ·· apâ D._â_ refl (sym $ D.assoc _ _ _) ·· p ηâ _) Ran-is-prop : â {p : Functor C C'} {F : Functor C D} â is-category D â is-prop (Ran p F) Ran-is-prop {C = C} {C' = C'} {D = D} {p = p} {F = F} d-cat Râ Râ = path where module Râ = Ran Râ module Râ = Ran Râ module Ru = Ran-unique Râ.has-ran Râ.has-ran open Ran c'd-cat : is-category Cat[ C' , D ] c'd-cat = Functor-is-category d-cat fp : Râ.Ext â¡ Râ.Ext fp = c'd-cat .to-path Ru.unique εp : PathP (λ i â fp i Fâ p => F) Râ.eps Râ.eps εp = Nat-pathp _ _ λ x â Univalent.Hom-pathp-refll-iso d-cat (Ru.counit ηâ _) path : Râ â¡ Râ path i .Ext = fp i path i .eps = εp i path i .has-ran = is-propâpathp (λ i â is-ran-is-prop {p = p} {F} {fp i} {εp i}) Râ.has-ran Râ.has-ran i