theory Limit imports FreeCategory DiscreteCategory Adjunction begin
text‹
This theory defines the notion of limit in terms of diagrams and cones and relates
it to the concept of a representation of a functor. The diagonal functor associated
with a diagram shape @{term J} is defined and it is shown that a right adjoint to
the diagonal functor gives limits of shape @{term J} and that a category has limits
of shape @{term J} if and only if the diagonal functor is a left adjoint functor.
Products and equalizers are defined as special cases of limits, and it is shown
that a category with equalizers has limits of shape @{term J} if it has products
indexed by the sets of objects and arrows of @{term J}.
The existence of limits in a set category is investigated, and it is shown that
every set category has equalizers and that a set category @{term S} has @{term I}-indexed
products if and only if the universe of @{term S} ``admits @{term I}-indexed tupling.''
The existence of limits in functor categories is also developed, showing that
limits in functor categories are ``determined pointwise'' and that a functor category
@{term "[A, B]"} has limits of shape @{term J} if @{term B} does.
Finally, it is shown that the Yoneda functor preserves limits.
This theory concerns itself only with limits; I have made no attempt to consider colimits.
Although it would be possible to rework the entire development in dual form,
it is possible that there is a more efficient way to dualize at least parts of it without
repeating all the work. This is something that deserves further thought. ›
section"Representations of Functors"
text‹
A representation of a contravariant functor ‹F: Cop → S›, where @{term S}
is a set category that is the target of a hom-functor for @{term C}, consists of
an object @{term a} of @{term C} and a natural isomorphism @{term "Φ: Y a → F"},
where ‹Y: C → [Cop, S]› is the Yoneda functor. ›
locale representation_of_functor =
C: category C +
Cop: dual_category C +
S: set_category S setp +
F: "functor" Cop.comp S F +
Hom: hom_functor C S setp φ +
Ya: yoneda_functor_fixed_object C S setp φ a +
natural_isomorphism Cop.comp S ‹Ya.Y a› F Φ for C :: "'c comp" (infixr‹⋅›55) and S :: "'s comp" (infixr‹⋅S›55) and setp :: "'s set ==> bool" and φ :: "'c * 'c ==> 'c ==> 's" and F :: "'c ==> 's" and a :: 'c and Φ :: "'c ==> 's" begin
abbreviation Y where"Y ≡ Ya.Y" abbreviation ψ where"ψ ≡ Hom.ψ"
end
text‹
Two representations of the same functor are uniquely isomorphic. ›
locale two_representations_one_functor =
C: category C +
Cop: dual_category C +
S: set_category S setp +
F: set_valued_functor Cop.comp S setp F +
yoneda_functor C S setp φ +
Ya: yoneda_functor_fixed_object C S setp φ a +
Ya': yoneda_functor_fixed_object C S setp φ a' +
Φ: representation_of_functor C S setp φ F a Φ +
Φ': representation_of_functor C S setp φ F a' Φ' for C :: "'c comp" (infixr‹⋅›55) and S :: "'s comp" (infixr‹⋅S›55) and setp :: "'s set ==> bool" and F :: "'c ==> 's" and φ :: "'c * 'c ==> 'c ==> 's" and a :: 'c and Φ :: "'c ==> 's" and a' :: 'c and Φ' :: "'c ==> 's" begin
interpretation Ψ: inverse_transformation Cop.comp S ‹Y a› F Φ .. interpretation Ψ': inverse_transformation Cop.comp S ‹Y a'› F Φ' .. interpretation ΦΨ': vertical_composite Cop.comp S ‹Y a› F ‹Y a'› Φ Ψ'.map .. interpretation Φ'Ψ: vertical_composite Cop.comp S ‹Y a'› F ‹Y a› Φ' Ψ.map ..
lemma are_uniquely_isomorphic: shows"∃!φ. «φ : a → a'¬∧ C.iso φ ∧ map φ = Cop_S.MkArr (Y a) (Y a') ΦΨ'.map" proof - interpret ΦΨ': natural_isomorphism Cop.comp S ‹Y a›‹Y a'› ΦΨ'.map using Φ.natural_isomorphism_axioms Ψ'.natural_isomorphism_axioms
natural_isomorphisms_compose by blast interpret Φ'Ψ: natural_isomorphism Cop.comp S ‹Y a'›‹Y a› Φ'Ψ.map using Φ'.natural_isomorphism_axioms Ψ.natural_isomorphism_axioms
natural_isomorphisms_compose by blast interpret ΦΨ'_Φ'Ψ: inverse_transformations Cop.comp S ‹Y a›‹Y a'› ΦΨ'.map Φ'Ψ.map proof fix x assume X: "Cop.ide x" show"S.inverse_arrows (ΦΨ'.map x) (Φ'Ψ.map x)" using S.inverse_arrows_compose S.inverse_arrows_sym X Φ'Ψ.map_simp_ide
ΦΨ'.map_simp_ide Ψ'.inverts_components Ψ.inverts_components by force qed have"Cop_S.inverse_arrows (Cop_S.MkArr (Y a) (Y a') ΦΨ'.map) (Cop_S.MkArr (Y a') (Y a) Φ'Ψ.map)" proof - have Ya: "functor Cop.comp S (Y a)" .. have Ya': "functor Cop.comp S (Y a')" .. have ΦΨ': "natural_transformation Cop.comp S (Y a) (Y a') ΦΨ'.map" .. have Φ'Ψ: "natural_transformation Cop.comp S (Y a') (Y a) Φ'Ψ.map" .. show ?thesis by (metis (no_types, lifting) Cop_S.arr_MkArr Cop_S.comp_MkArr Cop_S.ide_MkIde
Cop_S.inverse_arrows_def Ya'.functor_axioms Ya.functor_axioms
Φ'Ψ.natural_transformation_axioms ΦΨ'.natural_transformation_axioms
ΦΨ'_Φ'Ψ.inverse_transformations_axioms inverse_transformations_inverse(1-2)
mem_Collect_eq) qed hence3: "Cop_S.iso (Cop_S.MkArr (Y a) (Y a') ΦΨ'.map)"using Cop_S.isoI by blast hence"∃f. «f : a → a'¬∧ map f = Cop_S.MkArr (Y a) (Y a') ΦΨ'.map" using Ya.ide_a Ya'.ide_a is_full Y_def Cop_S.iso_is_arr full_functor.is_full
Cop_S.MkArr_in_hom ΦΨ'.natural_transformation_axioms preserves_ide by force from this obtain φ where φ: "«φ : a → a'¬∧ map φ = Cop_S.MkArr (Y a) (Y a') ΦΨ'.map" by blast show ?thesis by (metis 3 C.in_homE φ is_faithful reflects_iso) qed
end
section"Diagrams and Cones"
text‹
A \emph{diagram} in a category @{term C} is a functor ‹D: J → C›.
We refer to the category @{term J} as the diagram \emph{shape}.
Note that in the usual expositions of category theory that use set theory
as their foundations, the shape @{term J} of a diagram is required to be
a ``small'' category, where smallness means that the collection of objects
of @{term J}, as well as each of the ``homs,'' is a set.
However, in HOL there is no class of all sets, so it is not meaningful
to speak of @{term J} as ``small'' in any kind of absolute sense.
There is likely a meaningful notion of smallness of @{term J} \emph{relative to} @{term C} (the result below that states that a set
category has @{term I}-indexed products if and only if its universe
``admits @{term I}-indexed tuples'' is suggestive of how this might
be defined), but I haven't fully explored this idea at present. ›
locale diagram =
C: category C +
J: category J + "functor" J C D for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" begin
notation J.in_hom (‹«_ : _ →J _¬›)
end
lemma comp_diagram_functor: assumes"diagram J C D"and"functor J' J F" shows"diagram J' C (D o F)" by (meson assms(1) assms(2) diagram_def functor.axioms(1) functor_comp)
text‹
A \emph{cone} over a diagram ‹D: J → C› is a natural transformation
from a constant functor to @{term D}. The value of the constant functor is
the \emph{apex} of the cone. ›
locale cone =
C: category C +
J: category J +
D: diagram J C D +
A: constant_functor J C a +
natural_transformation J C A.map D χ for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" and a :: 'c and χ :: "'j ==> 'c" begin
lemma ide_apex: shows"C.ide a" using A.value_is_ide by auto
lemma component_in_hom: assumes"J.arr j" shows"«χ j : a → D (J.cod j)¬" using assms by auto
(* Suggested by Charles Staats, 12/13/2022 *) lemma cod_determines_component: assumes"J.arr j" shows"χ j = χ (J.cod j)" using assms naturality2 A.map_simp C.comp_arr_ide ide_apex preserves_reflects_arr by metis
end
text‹
A cone over diagram @{term D} is transformed into a cone over diagram @{term "D o F"}
by pre-composing with @{term F}. ›
lemma comp_cone_functor: assumes"cone J C D a χ"and"functor J' J F" shows"cone J' C (D o F) a (χ o F)" proof - interpret χ: cone J C D a χ using assms(1) by auto interpret F: "functor" J' J F using assms(2) by auto interpret A': constant_functor J' C a using χ.A.value_is_ide by unfold_locales auto have1: "χ.A.map o F = A'.map" using χ.A.map_def A'.map_def χ.J.not_arr_null by auto interpret χ': natural_transformation J' C A'.map ‹D o F›‹χ o F› using1 horizontal_composite F.as_nat_trans.natural_transformation_axioms
χ.natural_transformation_axioms by fastforce show"cone J' C (D o F) a (χ o F)" .. qed
text‹
A cone over diagram @{term D} can be transformed into a cone over a diagram @{term D'}
by post-composing with a natural transformation from @{term D} to @{term D'}. ›
lemma vcomp_transformation_cone: assumes"cone J C D a χ" and"natural_transformation J C D D' τ" shows"cone J C D' a (vertical_composite.map J C χ τ)" by (meson assms cone.axioms(4-5) cone.intro diagram.intro natural_transformation.axioms(1-4)
vertical_composite.intro vertical_composite.is_natural_transformation)
context"functor" begin
lemma preserves_diagrams: fixes J :: "'j comp" assumes"diagram J A D" shows"diagram J B (F o D)" by (meson assms diagram_def functor_axioms functor_comp functor_def)
lemma preserves_cones: fixes J :: "'j comp" assumes"cone J A D a χ" shows"cone J B (F o D) (F a) (F o χ)" proof - interpret χ: cone J A D a χ using assms by auto interpret Fa: constant_functor J B ‹F a› using χ.ide_apex by unfold_locales auto have1: "F o χ.A.map = Fa.map" using Fa.map_def extensionality by fastforce interpret χ': natural_transformation J B Fa.map ‹F o D›‹F o χ› using1 horizontal_composite χ.natural_transformation_axioms
as_nat_trans.natural_transformation_axioms by fastforce show"cone J B (F o D) (F a) (F o χ)" .. qed
end
context diagram begin
abbreviation cone where"cone a χ ≡ Limit.cone J C D a χ"
abbreviation cones :: "'c ==> ('j ==> 'c) set" where"cones a ≡ { χ. cone a χ }"
text‹
An arrow @{term "f ∈ C.hom a' a"} induces by composition a transformation from
cones with apex @{term a} to cones with apex @{term a'}. This transformation
is functorial in @{term f}. ›
abbreviation cones_map :: "'c ==> ('j ==> 'c) ==> ('j ==> 'c)" where"cones_map f ≡ (λχ ∈ cones (C.cod f). λj. if J.arr j then χ j ⋅ f else C.null)"
lemma cones_map_mapsto: assumes"C.arr f" shows"cones_map f ∈ extensional (cones (C.cod f)) ∩ (cones (C.cod f) → cones (C.dom f))" proof show"cones_map f ∈ extensional (cones (C.cod f))"by blast show"cones_map f ∈ cones (C.cod f) → cones (C.dom f)" proof fix χ assume"χ ∈ cones (C.cod f)" hence χ: "cone (C.cod f) χ"by auto interpret χ: cone J C D ‹C.cod f› χ using χ by auto interpret B: constant_functor J C ‹C.dom f› using assms by unfold_locales auto have"cone (C.dom f) (λj. if J.arr j then χ j ⋅ f else C.null)" using assms B.value_is_ide apply (unfold_locales, simp_all) apply (metis C.comp_assoc χ.naturality1) by (metis C.comp_arr_dom χ.cod_determines_component C.comp_assoc) thus"(λj. if J.arr j then χ j ⋅ f else C.null) ∈ cones (C.dom f)"by auto qed qed
lemma cones_map_ide: assumes"χ ∈ cones a" shows"cones_map a χ = χ" proof - interpret χ: cone J C D a χ using assms by auto show ?thesis using assms χ.A.value_is_ide χ.preserves_hom C.comp_arr_dom χ.extensionality by auto qed
lemma cones_map_comp: assumes"C.seq f g" shows"cones_map (f ⋅ g) = restrict (cones_map g o cones_map f) (cones (C.cod f))" proof (intro restr_eqI) show"cones (C.cod (f ⋅ g)) = cones (C.cod f)"using assms by simp show"∧χ. χ ∈ cones (C.cod (f ⋅ g)) ==> (λj. if J.arr j then χ j ⋅ f ⋅ g else C.null) = (cones_map g o cones_map f) χ" proof - fix χ assume χ: "χ ∈ cones (C.cod (f ⋅ g))" show"(λj. if J.arr j then χ j ⋅ f ⋅ g else C.null) = (cones_map g o cones_map f) χ" proof - have"((cones_map g) o (cones_map f)) χ = cones_map g (cones_map f χ)" by force alsohave"... = (λj. if J.arr j then (λj. if J.arr j then χ j ⋅ f else C.null) j ⋅ g else C.null)" proof fix j have"cone (C.dom f) (cones_map f χ)" using assms χ cones_map_mapsto by (elim C.seqE, force) thus"cones_map g (cones_map f χ) j = (if J.arr j then C (if J.arr j then χ j ⋅ f else C.null) g else C.null)" using χ assms by auto qed alsohave"... = (λj. if J.arr j then χ j ⋅ f ⋅ g else C.null)" using C.comp_assoc by fastforce finallyshow ?thesis by auto qed qed qed
end
text‹
Changing the apex of a cone by pre-composing with an arrow @{term f} commutes
with changing the diagram of a cone by post-composing with a natural transformation. ›
lemma cones_map_vcomp: assumes"diagram J C D"and"diagram J C D'" and"natural_transformation J C D D' τ" and"cone J C D a χ" and f: "partial_composition.in_hom C f a' a" shows"diagram.cones_map J C D' f (vertical_composite.map J C χ τ) = vertical_composite.map J C (diagram.cones_map J C D f χ) τ" proof - interpret D: diagram J C D using assms(1) by auto interpret D': diagram J C D' using assms(2) by auto interpret τ: natural_transformation J C D D' τ using assms(3) by auto interpret χ: cone J C D a χ using assms(4) by auto interpret τoχ: vertical_composite J C χ.A.map D D' χ τ .. interpret τoχ: cone J C D' a τoχ.map .. interpret χf: cone J C D a' ‹D.cones_map f χ› using f χ.cone_axioms D.cones_map_mapsto by blast interpret τoχf: vertical_composite J C χf.A.map D D' ‹D.cones_map f χ› τ .. interpret τoχ_f: cone J C D' a' ‹D'.cones_map f τoχ.map› using f τoχ.cone_axioms D'.cones_map_mapsto [of f] by blast
write C (infixr‹⋅›55) show"D'.cones_map f τoχ.map = τoχf.map" proof (intro natural_transformation_eqI) show"natural_transformation J C χf.A.map D' (D'.cones_map f τoχ.map)" .. show"natural_transformation J C χf.A.map D' τoχf.map" .. show"∧j. D.J.ide j ==> D'.cones_map f τoχ.map j = τoχf.map j" proof - fix j assume j: "D.J.ide j" have"D'.cones_map f τoχ.map j = τoχ.map j ⋅ f" using f τoχ.cone_axioms τoχ.map_simp_2 τoχ.extensionality by auto alsohave"... = (τ j ⋅ χ (D.J.dom j)) ⋅ f" using j τoχ.map_simp_2 by simp alsohave"... = τ j ⋅ χ (D.J.dom j) ⋅ f" using D.C.comp_assoc by simp alsohave"... = τoχf.map j" using j f χ.cone_axioms τoχf.map_simp_2 by auto finallyshow"D'.cones_map f τoχ.map j = τoχf.map j"by auto qed qed qed
text‹
Given a diagram @{term D}, we can construct a contravariant set-valued functor,
which takes each object @{term a} of @{term C} to the set of cones over @{term D}
with apex @{term a}, and takes each arrow @{term f} of @{term C} to the function
on cones over @{term D} induced by pre-composition with @{term f}.
For this, we need to introduce a set category @{term S} whose universe is large
enough to contain all the cones over @{term D}, and we need to have an explicit
correspondence between cones and elements of the universe of @{term S}.
A replete set category @{term S} equipped with an injective mapping
@{term_type "ι :: ('j => 'c) => 's"} serves this purpose. › locale cones_functor =
C: category C +
Cop: dual_category C +
J: category J +
D: diagram J C D +
S: replete_concrete_set_category S UNIV ι for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" and S :: "'s comp" (infixr‹⋅S›55) and ι :: "('j ==> 'c) ==> 's" begin
notation S.in_hom (‹«_ : _ →S _¬›)
abbreviationowhere"o≡ S.DN"
definition map :: "'c ==> 's" where"map = (λf. if C.arr f then S.mkArr (ι ` D.cones (C.cod f)) (ι ` D.cones (C.dom f)) (ι o D.cones_map f o o) else S.null)"
lemma map_simp [simp]: assumes"C.arr f" shows"map f = S.mkArr (ι ` D.cones (C.cod f)) (ι ` D.cones (C.dom f)) (ι o D.cones_map f o o)" using assms map_def by auto
lemma arr_map: assumes"C.arr f" shows"S.arr (map f)" proof - have"ι o D.cones_map f o o∈ ι ` D.cones (C.cod f) → ι ` D.cones (C.dom f)" using assms D.cones_map_mapsto by force thus ?thesis using assms S.UP_mapsto by auto qed
lemma map_ide: assumes"C.ide a" shows"map a = S.mkIde (ι ` D.cones a)" proof - have"map a = S.mkArr (ι ` D.cones a) (ι ` D.cones a) (ι o D.cones_map a o o)" using assms map_simp by force alsohave"... = S.mkArr (ι ` D.cones a) (ι ` D.cones a) (λx. x)" using S.UP_mapsto D.cones_map_ide by force alsohave"... = S.mkIde (ι ` D.cones a)" using assms S.mkIde_as_mkArr S.UP_mapsto by blast finallyshow ?thesis by auto qed
lemma map_preserves_dom: assumes"Cop.arr f" shows"map (Cop.dom f) = S.dom (map f)" using assms arr_map map_ide by auto
lemma map_preserves_cod: assumes"Cop.arr f" shows"map (Cop.cod f) = S.cod (map f)" using assms arr_map map_ide by auto
lemma map_preserves_comp: assumes"Cop.seq g f" shows"map (g ⋅op f) = map g ⋅S map f" proof - have"map (g ⋅op f) = S.mkArr (ι ` D.cones (C.cod f)) (ι ` D.cones (C.dom g)) ((ι o D.cones_map g o o) o (ι o D.cones_map f o o))" proof - have1: "S.arr (map (g ⋅op f))" using assms arr_map [of "C f g"] by simp have"map (g ⋅op f) = S.mkArr (ι ` D.cones (C.cod f)) (ι ` D.cones (C.dom g)) (ι o D.cones_map (C f g) o o)" using assms map_simp [of "C f g"] by simp alsohave"... = S.mkArr (ι ` D.cones (C.cod f)) (ι ` D.cones (C.dom g)) ((ι o D.cones_map g o o) o (ι o D.cones_map f o o))" using assms 1 calculation D.cones_map_mapsto D.cones_map_comp by auto finallyshow ?thesis by blast qed alsohave"... = map g ⋅S map f" using assms arr_map [of f] arr_map [of g] map_simp S.comp_mkArr by auto finallyshow ?thesis by auto qed
lemma is_functor: shows"functor Cop.comp S map" apply (unfold_locales) using map_def arr_map map_preserves_dom map_preserves_cod map_preserves_comp by auto
end
sublocale cones_functor ⊆"functor" Cop.comp S map using is_functor by auto sublocale cones_functor ⊆ set_valued_functor Cop.comp S ‹λA. A ⊆ S.Univ› map ..
section"Limits"
subsection"Limit Cones"
text‹
A \emph{limit cone} for a diagram @{term D} is a cone @{term χ} over @{term D}
with the universal property that any other cone @{term χ'} over the diagram @{term D}
factors uniquely through @{term χ}. ›
locale limit_cone =
C: category C +
J: category J +
D: diagram J C D +
cone J C D a χ for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" and a :: 'c and χ :: "'j ==> 'c" + assumes is_universal: "cone J C D a' χ' ==>∃!f. «f : a' → a¬∧ D.cones_map f χ = χ'" begin
lemma is_cone [simp]: shows"χ ∈ D.cones a" using cone_axioms by simp
definition induced_arrow :: "'c ==> ('j ==> 'c) ==> 'c" where"induced_arrow a' χ' = (THE f. «f : a' → a¬∧ D.cones_map f χ = χ')"
lemma induced_arrowI: assumes χ': "χ' ∈ D.cones a'" shows"«induced_arrow a' χ' : a' → a¬" and"D.cones_map (induced_arrow a' χ') χ = χ'" proof - have"∃!f. «f : a' → a¬∧ D.cones_map f χ = χ'" using assms χ' is_universal by simp hence1: "«induced_arrow a' χ' : a' → a¬∧ D.cones_map (induced_arrow a' χ') χ = χ'" using theI' [of "λf. «f : a' → a¬∧ D.cones_map f χ = χ'"] induced_arrow_def by presburger show"«induced_arrow a' χ' : a' → a¬"using1by simp show"D.cones_map (induced_arrow a' χ') χ = χ'"using1by simp qed
lemma cones_map_induced_arrow: shows"induced_arrow a' ∈ D.cones a' → C.hom a' a" and"∧χ'. χ' ∈ D.cones a' ==> D.cones_map (induced_arrow a' χ') χ = χ'" using induced_arrowI by auto
lemma induced_arrow_cones_map: assumes"C.ide a'" shows"(λf. D.cones_map f χ) ∈ C.hom a' a → D.cones a'" and"∧f. «f : a' → a¬==> induced_arrow a' (D.cones_map f χ) = f" proof - have a': "C.ide a'"using assms by (simp add: cone.ide_apex) have cone_χ: "cone J C D a χ" .. show"(λf. D.cones_map f χ) ∈ C.hom a' a → D.cones a'" using cone_χ D.cones_map_mapsto by blast fix f assume f: "«f : a' → a¬" show"induced_arrow a' (D.cones_map f χ) = f" proof - have"D.cones_map f χ ∈ D.cones a'" using f cone_χ D.cones_map_mapsto by blast hence"∃!f'. «f' : a' → a¬∧ D.cones_map f' χ = D.cones_map f χ" using assms is_universal by auto thus ?thesis using f induced_arrow_def
the1_equality [of "λf'. «f' : a' → a¬∧ D.cones_map f' χ = D.cones_map f χ"] by presburger qed qed
text‹
For a limit cone @{term χ} with apex @{term a}, for each object @{term a'} the
hom-set @{term "C.hom a' a"} is in bijective correspondence with the set of cones
with apex @{term a'}. ›
lemma bij_betw_hom_and_cones: assumes"C.ide a'" shows"bij_betw (λf. D.cones_map f χ) (C.hom a' a) (D.cones a')" proof (intro bij_betwI) show"(λf. D.cones_map f χ) ∈ C.hom a' a → D.cones a'" using assms induced_arrow_cones_map by blast show"induced_arrow a' ∈ D.cones a' → C.hom a' a" using assms cones_map_induced_arrow by blast show"∧f. f ∈ C.hom a' a ==> induced_arrow a' (D.cones_map f χ) = f" using assms induced_arrow_cones_map by blast show"∧χ'. χ' ∈ D.cones a' ==> D.cones_map (induced_arrow a' χ') χ = χ'" using assms cones_map_induced_arrow by blast qed
lemma induced_arrow_eqI: assumes"D.cone a' χ'"and"«f : a' → a¬"and"D.cones_map f χ = χ'" shows"induced_arrow a' χ' = f" using assms is_universal induced_arrow_def
the1_equality [of "λf. f ∈ C.hom a' a ∧ D.cones_map f χ = χ'" f] by simp
lemma induced_arrow_self: shows"induced_arrow a χ = a" proof - have"«a : a → a¬∧ D.cones_map a χ = χ" using ide_apex cone_axioms D.cones_map_ide by force thus ?thesis using induced_arrow_eqI cone_axioms by auto qed
end
context diagram begin
abbreviation limit_cone where"limit_cone a χ ≡ Limit.limit_cone J C D a χ"
text‹
A diagram @{term D} has object @{term a} as a limit if @{term a} is the apex
of some limit cone over @{term D}. ›
abbreviation has_as_limit :: "'c ==> bool" where"has_as_limit a ≡ (∃χ. limit_cone a χ)"
lemma limit_cone_some_limit_cone: assumes has_limit shows"limit_cone some_limit some_limit_cone" proof - have"∃a. has_as_limit a"using assms by simp hence"has_as_limit some_limit" using some_limit_def someI_ex [of "λa. ∃χ. limit_cone a χ"] by simp thus"limit_cone some_limit some_limit_cone" using assms some_limit_cone_def someI_ex [of "λχ. limit_cone some_limit χ"] by simp qed
lemma has_limitE: assumes has_limit obtains a χ where"limit_cone a χ" using assms someI_ex by blast
end
subsection"Limits by Representation"
text‹
A limit for a diagram D can also be given by a representation ‹(a, Φ)›
of the cones functor. ›
locale representation_of_cones_functor =
C: category C +
Cop: dual_category C +
J: category J +
D: diagram J C D +
S: replete_concrete_set_category S UNIV ι +
Cones: cones_functor J C D S ι +
Hom: hom_functor C S ‹λA. A ⊆ S.Univ› φ +
representation_of_functor C S S.setp φ Cones.map a Φ for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" and S :: "'s comp" (infixr‹⋅S›55) and φ :: "'c * 'c ==> 'c ==> 's" and ι :: "('j ==> 'c) ==> 's" and a :: 'c and Φ :: "'c ==> 's"
subsection"Putting it all Together"
text‹
A ``limit situation'' combines and connects the ways of presenting a limit. ›
locale limit_situation =
C: category C +
Cop: dual_category C +
J: category J +
D: diagram J C D +
S: replete_concrete_set_category S UNIV ι +
Cones: cones_functor J C D S ι +
Hom: hom_functor C S S.setp φ +
Φ: representation_of_functor C S S.setp φ Cones.map a Φ +
χ: limit_cone J C D a χ for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and D :: "'j ==> 'c" and S :: "'s comp" (infixr‹⋅S›55) and φ :: "'c * 'c ==> 'c ==> 's" and ι :: "('j ==> 'c) ==> 's" and a :: 'c and Φ :: "'c ==> 's" and χ :: "'j ==> 'c" + assumes χ_in_terms_of_Φ: "χ = S.DN (S.Fun (Φ a) (φ (a, a) a))" and Φ_in_terms_of_χ: "Cop.ide a' ==> Φ a' = S.mkArr (Hom.set (a', a)) (ι ` D.cones a') (λx. ι (D.cones_map (Hom.ψ (a', a) x) χ))"
text (in limit_situation) ‹
The assumption @{prop χ_in_terms_of_Φ} states that the universal cone @{term χ} is obtained
by applying the function @{term "S.Fun (Φ a)"} to the identity @{term a} of
@{term[source=true] C} (after taking into account the necessary coercions). ›
text (in limit_situation) ‹
The assumption @{prop Φ_in_terms_of_χ} states that the component of @{term Φ} at @{term a'}
is the arrow of @{term[source=true] S} corresponding to the function that takes an arrow
@{term "f ∈ C.hom a' a"} and produces the cone with vertex @{term a'} obtained
by transforming the universal cone @{term χ} by @{term f}. ›
subsection"Limit Cones Induce Limit Situations"
text‹
To obtain a limit situation from a limit cone, we need to introduce a set category
that is large enough to contain the hom-sets of @{term C} as well as the cones
over @{term D}. We use the category of all @{typ "('c + ('j ==> 'c))"}-sets for this. ›
context limit_cone begin
interpretation Cop: dual_category C .. interpretation CopxC: product_category Cop.comp C .. interpretation S: replete_setcat ‹TYPE('c + ('j ==> 'c))› .
notation S.comp (infixr‹⋅S›55)
interpretation Sr: replete_concrete_set_category S.comp UNIV ‹S.UP o Inr› apply unfold_locales using S.UP_mapsto apply auto[1] using S.inj_UP inj_Inr inj_compose by metis
interpretation Cones: cones_functor J C D S.comp ‹S.UP o Inr› ..
interpretation Hom: hom_functor C S.comp S.setp ‹λ_. S.UP o Inl› apply (unfold_locales) using S.UP_mapsto apply auto[1] using S.inj_UP injD inj_onI inj_Inl inj_compose apply (metis (no_types, lifting)) using S.UP_mapsto by auto
interpretation Y: yoneda_functor C S.comp S.setp ‹λ_. S.UP o Inl› .. interpretation Ya: yoneda_functor_fixed_object C S.comp S.setp ‹λ_. S.UP o Inl› a apply (unfold_locales) using ide_apex by auto
lemma Ya_ide: assumes a': "C.ide a'" shows"Y a a' = S.mkIde (Hom.set (a', a))" using assms ide_apex Y.Y_simp Hom.map_ide by simp
lemma Ya_arr: assumes g: "C.arr g" shows"Y a g = S.mkArr (Hom.set (C.cod g, a)) (Hom.set (C.dom g, a)) (φ (C.dom g, a) o Cop.comp g o ψ (C.cod g, a))" using ide_apex g Y.Y_ide_arr [of a g "C.dom g""C.cod g"] by auto
text‹
For each object @{term a'} of @{term[source=true] C} we have a function mapping
@{term "C.hom a' a"} to the set of cones over @{term D} with apex @{term a'},
which takes @{term "f ∈ C.hom a' a"} to ‹χf›, where ‹χf› is the cone obtained by
composing @{term χ} with @{term f} (after accounting for coercions to and from the
universe of @{term S}). The corresponding arrows of @{term S} are the
components of a natural isomorphism from @{term "Y a"} to ‹Cones›. ›
lemma Φo_in_hom: assumes a': "C.ide a'" shows"«Φo a' : S.mkIde (Hom.set (a', a)) →S S.mkIde (ι ` D.cones a')¬" proof - have" «S.mkArr (Hom.set (a', a)) (ι ` D.cones a') (λx. ι (D.cones_map (ψ (a', a) x) χ)) : S.mkIde (Hom.set (a', a)) →S S.mkIde (ι ` D.cones a')¬" proof - have"(λx. ι (D.cones_map (ψ (a', a) x) χ)) ∈ Hom.set (a', a) → ι ` D.cones a'" proof fix x assume x: "x ∈ Hom.set (a', a)" hence"«ψ (a', a) x : a' → a¬" using ide_apex a' Hom.ψ_mapsto by auto hence"D.cones_map (ψ (a', a) x) χ ∈ D.cones a'" using ide_apex a' x D.cones_map_mapsto is_cone by force thus"ι (D.cones_map (ψ (a', a) x) χ) ∈ ι ` D.cones a'"by simp qed moreoverhave"Hom.set (a', a) ⊆ S.Univ" using ide_apex a' Hom.set_subset_Univ by auto moreoverhave"ι ` D.cones a' ⊆ S.Univ" using S.UP_mapsto by auto ultimatelyshow ?thesis using S.mkArr_in_hom by simp qed thus ?thesis using Φo_def [of a'] by auto qed
interpretation Φ: transformation_by_components Cop.comp S.comp ‹Y a› Cones.map Φo proof fix a' assume A': "Cop.ide a'" show"«Φo a' : Y a a' →S Cones.map a'¬" using A' Ya_ide Φo_in_hom Cones.map_ide by auto next fix g assume g: "Cop.arr g" show"Φo (Cop.cod g) ⋅S Y a g = Cones.map g ⋅S Φo (Cop.dom g)" proof - let ?A = "Hom.set (C.cod g, a)" let ?B = "Hom.set (C.dom g, a)" let ?B' = "ι ` D.cones (C.cod g)" let ?C = "ι ` D.cones (C.dom g)" let ?F = "φ (C.dom g, a) o Cop.comp g o ψ (C.cod g, a)" let ?F' = "ι o D.cones_map g o o" let ?G = "λx. ι (D.cones_map (ψ (C.dom g, a) x) χ)" let ?G' = "λx. ι (D.cones_map (ψ (C.cod g, a) x) χ)" have"S.arr (Y a g) ∧ Y a g = S.mkArr ?A ?B ?F" using ide_apex g Ya.preserves_arr Ya_arr by fastforce moreoverhave"S.arr (Φo (Cop.cod g))" using g Φo_in_hom [of "Cop.cod g"] by auto moreoverhave"Φo (Cop.cod g) = S.mkArr ?B ?C ?G" using g Φo_def [of "C.dom g"] by auto moreoverhave"S.seq (Φo (Cop.cod g)) (Y a g)" using ide_apex g Φo_in_hom [of "Cop.cod g"] by auto ultimatelyhave1: "S.seq (Φo (Cop.cod g)) (Y a g) ∧ Φo (Cop.cod g) ⋅S Y a g = S.mkArr ?A ?C (?G o ?F)" using S.comp_mkArr [of ?A ?B ?F ?C ?G] by argo
have"Cones.map g = S.mkArr (ι ` D.cones (C.cod g)) (ι ` D.cones (C.dom g)) ?F'" using g Cones.map_simp by fastforce moreoverhave"Φo (Cop.dom g) = S.mkArr ?A ?B' ?G'" using g Φo_def by fastforce moreoverhave"S.seq (Cones.map g) (Φo (Cop.dom g))" using g Cones.preserves_hom [of g "C.cod g""C.dom g"] Φo_in_hom [of "Cop.dom g"] by force ultimatelyhave 2: "S.seq (Cones.map g) (Φo (Cop.dom g)) ∧ Cones.map g ⋅S Φo (Cop.dom g) = S.mkArr ?A ?C (?F' o ?G')" using S.seqI' [of "Φo (Cop.dom g)""Cones.map g"] S.comp_mkArr by auto
have"Φo (Cop.cod g) ⋅S Y a g = S.mkArr ?A ?C (?G o ?F)" using1by auto alsohave"... = S.mkArr ?A ?C (?F' o ?G')" proof (intro S.mkArr_eqI') show"S.arr (S.mkArr ?A ?C (?G o ?F))"using1by force show"∧x. x ∈ ?A ==> (?G o ?F) x = (?F' o ?G') x" proof - fix x assume x: "x ∈ ?A" hence1: "«ψ (C.cod g, a) x : C.cod g → a¬" using ide_apex g Hom.ψ_mapsto [of "C.cod g" a] by auto have"(?G o ?F) x = ι (D.cones_map (ψ (C.dom g, a) (φ (C.dom g, a) (ψ (C.cod g, a) x ⋅ g))) χ)" proof - (* Why is it so balky with this proof? *) have"(?G o ?F) x = ?G (?F x)"by simp alsohave"... = ι (D.cones_map (ψ (C.dom g, a) (φ (C.dom g, a) (ψ (C.cod g, a) x ⋅ g))) χ)" by (metis Cop.comp_def comp_apply) finallyshow ?thesis by auto qed alsohave"... = ι (D.cones_map (ψ (C.cod g, a) x ⋅ g) χ)" proof - have"«ψ (C.cod g, a) x ⋅ g : C.dom g → a¬"using g 1by auto thus ?thesis using Hom.ψ_φ by presburger qed alsohave"... = ι (D.cones_map g (D.cones_map (ψ (C.cod g, a) x) χ))" using g x 1 is_cone D.cones_map_comp [of "ψ (C.cod g, a) x" g] by fastforce alsohave"... = ι (D.cones_map g (o (ι (D.cones_map (ψ (C.cod g, a) x) χ))))" using1 is_cone D.cones_map_mapsto Sr.DN_UP by auto alsohave"... = (?F' o ?G') x"by simp finallyshow"(?G o ?F) x = (?F' o ?G') x"by auto qed qed alsohave"... = Cones.map g ⋅S Φo (Cop.dom g)" using2by auto finallyshow ?thesis by auto qed qed
interpretation Φ: natural_isomorphism Cop.comp S.comp ‹Y a› Cones.map Φ.map proof fix a' assume a': "Cop.ide a'" show"S.iso (Φ.map a')" proof - let ?F = "λx. ι (D.cones_map (ψ (a', a) x) χ)" have bij: "bij_betw ?F (Hom.set (a', a)) (ι ` D.cones a')" proof - have"∧x x'. [ x ∈ Hom.set (a', a); x' ∈ Hom.set (a', a); ι (D.cones_map (ψ (a', a) x) χ) = ι (D.cones_map (ψ (a', a) x') χ) ] ==> x = x'" proof - fix x x' assume x: "x ∈ Hom.set (a', a)"and x': "x' ∈ Hom.set (a', a)" and xx': "ι (D.cones_map (ψ (a', a) x) χ) = ι (D.cones_map (ψ (a', a) x') χ)" have ψx: "«ψ (a', a) x : a' → a¬"using x ide_apex a' Hom.ψ_mapsto by auto have ψx': "«ψ (a', a) x' : a' → a¬"using x' ide_apex a' Hom.ψ_mapsto by auto have1: "∃!f. «f : a' → a¬∧ ι (D.cones_map f χ) = ι (D.cones_map (ψ (a', a) x) χ)" proof - have"D.cones_map (ψ (a', a) x) χ ∈ D.cones a'" using ψx a' is_cone D.cones_map_mapsto by force hence2: "∃!f. «f : a' → a¬∧ D.cones_map f χ = D.cones_map (ψ (a', a) x) χ" using a' is_universal by simp show"∃!f. «f : a' → a¬∧ ι (D.cones_map f χ) = ι (D.cones_map (ψ (a', a) x) χ)" proof - have"∧f. ι (D.cones_map f χ) = ι (D.cones_map (ψ (a', a) x) χ) ⟷ D.cones_map f χ = D.cones_map (ψ (a', a) x) χ" proof - fix f :: 'c have"D.cones_map f χ = D.cones_map (ψ (a', a) x) χ ⟶ ι (D.cones_map f χ) = ι (D.cones_map (ψ (a', a) x) χ)" by simp thus"(ι (D.cones_map f χ) = ι (D.cones_map (ψ (a', a) x) χ)) = (D.cones_map f χ = D.cones_map (ψ (a', a) x) χ)" by (meson Sr.inj_UP injD) qed thus ?thesis using2by auto qed qed have2: "∃!x''. x'' ∈ Hom.set (a', a) ∧ ι (D.cones_map (ψ (a', a) x'') χ) = ι (D.cones_map (ψ (a', a) x) χ)" proof - from1obtain f'' where
f'': "«f'' : a' → a¬∧ ι (D.cones_map f'' χ) = ι (D.cones_map (ψ (a', a) x) χ)" by blast have"φ (a', a) f'' ∈ Hom.set (a', a) ∧ ι (D.cones_map (ψ (a', a) (φ (a', a) f'')) χ) = ι (D.cones_map (ψ (a', a) x) χ)" proof show"φ (a', a) f'' ∈ Hom.set (a', a)"using f'' Hom.set_def by auto show"ι (D.cones_map (ψ (a', a) (φ (a', a) f'')) χ) = ι (D.cones_map (ψ (a', a) x) χ)" using f'' Hom.ψ_φ by presburger qed moreoverhave "∧x''. x'' ∈ Hom.set (a', a) ∧ ι (D.cones_map (ψ (a', a) x'') χ) = ι (D.cones_map (ψ (a', a) x) χ) ==> x'' = φ (a', a) f''" proof - fix x'' assume x'': "x'' ∈ Hom.set (a', a) ∧ ι (D.cones_map (ψ (a', a) x'') χ) = ι (D.cones_map (ψ (a', a) x) χ)" hence"«ψ (a', a) x'' : a' → a¬∧ ι (D.cones_map (ψ (a', a) x'') χ) = ι (D.cones_map (ψ (a', a) x) χ)" using ide_apex a' Hom.set_def Hom.ψ_mapsto [of a' a] by auto hence"φ (a', a) (ψ (a', a) x'') = φ (a', a) f''" using1 f'' by auto thus"x'' = φ (a', a) f''" using ide_apex a' x'' Hom.φ_ψ by simp qed ultimatelyshow ?thesis using ex1I [of "λx'. x' ∈ Hom.set (a', a) ∧ ι (D.cones_map (ψ (a', a) x') χ) = ι (D.cones_map (ψ (a', a) x) χ)" "φ (a', a) f''"] by simp qed thus"x = x'"using x x' xx' by auto qed hence"inj_on ?F (Hom.set (a', a))" using inj_onI [of "Hom.set (a', a)" ?F] by auto moreoverhave"?F ` Hom.set (a', a) = ι ` D.cones a'" proof show"?F ` Hom.set (a', a) ⊆ ι ` D.cones a'" proof fix X' assume X': "X' ∈ ?F ` Hom.set (a', a)" from this obtain x' where x': "x' ∈ Hom.set (a', a) ∧ ?F x' = X'"by blast show"X' ∈ ι ` D.cones a'" proof - have"X' = ι (D.cones_map (ψ (a', a) x') χ)"using x' by blast hence"X' = ι (D.cones_map (ψ (a', a) x') χ)"using x' by force moreoverhave"«ψ (a', a) x' : a' → a¬" using ide_apex a' x' Hom.set_def Hom.ψ_φ by auto ultimatelyshow ?thesis using x' is_cone D.cones_map_mapsto by force qed qed show"ι ` D.cones a' ⊆ ?F ` Hom.set (a', a)" proof fix X' assume X': "X' ∈ ι ` D.cones a'" hence"o X' ∈o ` ι ` D.cones a'"by simp with Sr.DN_UP have"o X' ∈ D.cones a'" by auto hence"∃!f. «f : a' → a¬∧ D.cones_map f χ = o X'" using a' is_universal by simp from this obtain f where"«f : a' → a¬∧ D.cones_map f χ = o X'" by auto hence f: "«f : a' → a¬∧ ι (D.cones_map f χ) = X'" using X' Sr.UP_DN by auto have"X' = ?F (φ (a', a) f)" using f Hom.ψ_φ by presburger thus"X' ∈ ?F ` Hom.set (a', a)" using f Hom.set_def by force qed qed ultimatelyshow ?thesis using bij_betw_def [of ?F "Hom.set (a', a)""ι ` D.cones a'"] inj_on_def by auto qed let ?f = "S.mkArr (Hom.set (a', a)) (ι ` D.cones a') ?F" have iso: "S.iso ?f" proof - have"?F ∈ Hom.set (a', a) → ι ` D.cones a'" using bij bij_betw_imp_funcset by fast hence1: "S.arr ?f" using ide_apex a' Hom.set_subset_Univ S.UP_mapsto by auto thus ?thesis using bij S.iso_char S.set_mkIde by fastforce qed moreoverhave"?f = Φ.map a'" using a' Φo_def by force finallyshow ?thesis by auto qed qed
interpretation R: representation_of_functor C S.comp S.setp φ Cones.map a Φ.map ..
lemma χ_in_terms_of_Φ: shows"χ = o (Φ.FUN a (φ (a, a) a))" proof - have"Φ.FUN a (φ (a, a) a) = (λx ∈ Hom.set (a, a). ι (D.cones_map (ψ (a, a) x) χ)) (φ (a, a) a)" using ide_apex S.Fun_mkArr Φ.map_simp_ide Φo_def Φ.preserves_reflects_arr [of a] by simp alsohave"... = ι (D.cones_map a χ)" proof - have"(λx ∈ Hom.set (a, a). ι (D.cones_map (ψ (a, a) x) χ)) (φ (a, a) a) = ι (D.cones_map (ψ (a, a) (φ (a, a) a)) χ)" proof - have"φ (a, a) a ∈ Hom.set (a, a)" using ide_apex Hom.φ_mapsto by fastforce thus ?thesis using restrict_apply' [of "φ (a, a) a""Hom.set (a, a)"] by blast qed alsohave"... = ι (D.cones_map a χ)" proof - have"ψ (a, a) (φ (a, a) a) = a" using ide_apex Hom.ψ_φ [of a a a] by fastforce thus ?thesis by metis qed finallyshow ?thesis by auto qed finallyhave"Φ.FUN a (φ (a, a) a) = ι (D.cones_map a χ)"by auto alsohave"... = ι χ" using ide_apex D.cones_map_ide [of χ a] is_cone by simp finallyhave"Φ.FUN a (φ (a, a) a) = ι χ"by blast hence"o (Φ.FUN a (φ (a, a) a)) = o (ι χ)"by simp thus ?thesis using is_cone Sr.DN_UP by simp qed
abbreviation Hom where"Hom ≡ Hom.map"
abbreviation Φ where"Φ ≡ Φ.map"
lemma induces_limit_situation: shows"limit_situation J C D S.comp φ ι a Φ χ" using χ_in_terms_of_Φ Φo_def by unfold_locales auto
no_notation S.comp (infixr‹⋅S›55)
end
sublocale limit_cone ⊆ limit_situation J C D replete_setcat.comp φ ι a Φ χ using induces_limit_situation by auto
subsection"Representations of the Cones Functor Induce Limit Situations"
abbreviation χ where"χ ≡o (S.Fun (Φ a) (φ (a, a) a))"
lemma Cones_SET_eq_ι_img_cones: assumes"C.ide a'" shows"Cones.SET a' = ι ` D.cones a'" proof - have"ι ` D.cones a' ⊆ S.Univ"using S.UP_mapsto by auto thus ?thesis using assms Cones.map_ide S.set_mkIde by auto qed
lemma ιχ: shows"ι χ = S.Fun (Φ a) (φ (a, a) a)" proof - have"S.Fun (Φ a) (φ (a, a) a) ∈ Cones.SET a" using Ya.ide_a Hom.φ_mapsto S.Fun_mapsto [of "Φ a"] Hom.set_map by fastforce thus ?thesis using Ya.ide_a Cones_SET_eq_ι_img_cones by auto qed
interpretation χ: cone J C D a χ proof - have"ι χ ∈ ι ` D.cones a" using Ya.ide_a ιχ S.Fun_mapsto [of "Φ a"] Hom.φ_mapsto Hom.set_map
Cones_SET_eq_ι_img_cones by fastforce thus"D.cone a χ" by (metis (no_types, lifting) S.DN_UP UNIV_I f_inv_into_f inv_into_into mem_Collect_eq) qed
lemma cone_χ: shows"D.cone a χ" ..
lemma Φ_FUN_simp: assumes a': "C.ide a'"and x: "x ∈ Hom.set (a', a)" shows"Φ.FUN a' x = Cones.FUN (ψ (a', a) x) (ι χ)" proof - have ψx: "«ψ (a', a) x : a' → a¬" using Ya.ide_a a' x Hom.ψ_mapsto by blast have φa: "φ (a, a) a ∈ Hom.set (a, a)"using Ya.ide_a Hom.φ_mapsto by fastforce have"Φ.FUN a' x = (Φ.FUN a' o Ya.FUN (ψ (a', a) x)) (φ (a, a) a)" proof - have"φ (a', a) (a ⋅ ψ (a', a) x) = x" using Ya.ide_a a' x ψx Hom.φ_ψ C.comp_cod_arr by fastforce moreoverhave"S.arr (S.mkArr (Hom.set (a, a)) (Hom.set (a', a)) (φ (a', a) ∘ Cop.comp (ψ (a', a) x) ∘ ψ (a, a)))" by (metis C.arrI Cop.arr_char Ya.Y_ide_arr(2) Ya.preserves_arr χ.ide_apex ψx) ultimatelyshow ?thesis using Ya.ide_a a' x Ya.Y_ide_arr ψx φa C.ide_in_hom by auto qed alsohave"... = (Cones.FUN (ψ (a', a) x) o Φ.FUN a) (φ (a, a) a)" proof - have"(Φ.FUN a' o Ya.FUN (ψ (a', a) x)) (φ (a, a) a) = S.Fun (Φ a' ⋅S Y a (ψ (a', a) x)) (φ (a, a) a)" using ψx a' φa Ya.ide_a Ya.map_simp Hom.set_map by (elim C.in_homE, auto) alsohave"... = S.Fun (S (Cones.map (ψ (a', a) x)) (Φ a)) (φ (a, a) a)" using ψx naturality1 [of "ψ (a', a) x"] naturality2 [of "ψ (a', a) x"] by auto alsohave"... = (Cones.FUN (ψ (a', a) x) o Φ.FUN a) (φ (a, a) a)" proof - have"S.seq (Cones.map (ψ (a', a) x)) (Φ a)" using Ya.ide_a ψx Cones.map_preserves_dom [of "ψ (a', a) x"] apply (intro S.seqI) apply auto[2] by fastforce thus ?thesis using Ya.ide_a φa Hom.set_map by auto qed finallyshow ?thesis by simp qed alsohave"... = Cones.FUN (ψ (a', a) x) (ι χ)"using ιχ by simp finallyshow ?thesis by auto qed
lemma χ_is_universal: assumes"D.cone a' χ'" shows"«ψ (a', a) (Ψ.FUN a' (ι χ')) : a' → a¬" and"D.cones_map (ψ (a', a) (Ψ.FUN a' (ι χ'))) χ = χ'" and"[«f' : a' → a¬; D.cones_map f' χ = χ' ]==> f' = ψ (a', a) (Ψ.FUN a' (ι χ'))" proof - interpret χ': cone J C D a' χ' using assms by auto have a': "C.ide a'"using χ'.ide_apex by simp have ιχ': "ι χ' ∈ Cones.SET a'"using assms a' Cones_SET_eq_ι_img_cones by auto let ?f = "ψ (a', a) (Ψ.FUN a' (ι χ'))" have A: "Ψ.FUN a' (ι χ') ∈ Hom.set (a', a)" proof - have"Ψ.FUN a' ∈ Cones.SET a' → Ya.SET a'" using a' Ψ.preserves_hom [of a' a' a'] S.Fun_mapsto [of "Ψ.map a'"] by fastforce thus ?thesis using a' ιχ' Ya.ide_a Hom.set_map by auto qed show f: "«?f : a' → a¬"using A a' Ya.ide_a Hom.ψ_mapsto [of a' a] by auto have E: "∧f. «f : a' → a¬==> Cones.FUN f (ι χ) = Φ.FUN a' (φ (a', a) f)" proof - fix f assume f: "«f : a' → a¬" have"φ (a', a) f ∈ Hom.set (a', a)" using a' Ya.ide_a f Hom.φ_mapsto by auto thus"Cones.FUN f (ι χ) = Φ.FUN a' (φ (a', a) f)" using a' f Φ_FUN_simp by simp qed have I: "Φ.FUN a' (Ψ.FUN a' (ι χ')) = ι χ'" proof - have"Φ.FUN a' (Ψ.FUN a' (ι χ')) = compose (Ψ.DOM a') (Φ.FUN a') (Ψ.FUN a') (ι χ')" using a' ιχ' Cones.map_ide Ψ.preserves_hom [of a' a' a'] by force alsohave"... = (λx ∈ Ψ.DOM a'. x) (ι χ')" using a' Ψ.inverts_components S.inverse_arrows_char by force alsohave"... = ι χ'" using a' ιχ' Cones.map_ide Ψ.preserves_hom [of a' a' a'] by force finallyshow ?thesis by auto qed show fχ: "D.cones_map ?f χ = χ'" proof - have"D.cones_map ?f χ = (o o Cones.FUN ?f o ι) χ" using f Cones.preserves_arr [of ?f] cone_χ by (cases "D.cone a χ", auto) alsohave"... = χ'" using f Ya.ide_a a' A E I by auto finallyshow ?thesis by auto qed show"[«f' : a' → a¬; D.cones_map f' χ = χ' ]==> f' = ?f" proof - assume f': "«f' : a' → a¬"and f'χ: "D.cones_map f' χ = χ'" show"f' = ?f" proof - have1: "φ (a', a) f' ∈ Hom.set (a', a) ∧ φ (a', a) ?f ∈ Hom.set (a', a)" using Ya.ide_a a' f f' Hom.φ_mapsto by auto have"S.iso (Φ a')"using χ'.ide_apex components_are_iso by auto hence2: "S.arr (Φ a') ∧ bij_betw (Φ.FUN a') (Hom.set (a', a)) (Cones.SET a')" using Ya.ide_a a' S.iso_char Hom.set_map by auto have"Φ.FUN a' (φ (a', a) f') = Φ.FUN a' (φ (a', a) ?f)" proof - have"Φ.FUN a' (φ (a', a) ?f) = ι χ'" using A I Hom.φ_ψ Ya.ide_a a' by simp alsohave"... = Cones.FUN f' (ι χ)" using f f' A E cone_χ Cones.preserves_arr fχ f'χ by (elim C.in_homE, auto) alsohave"... = Φ.FUN a' (φ (a', a) f')" using f' E by simp finallyshow ?thesis by argo qed moreoverhave"inj_on (Φ.FUN a') (Hom.set (a', a))" using2 bij_betw_imp_inj_on by blast ultimatelyhave3: "φ (a', a) f' = φ (a', a) ?f" using1 inj_on_def [of "Φ.FUN a'""Hom.set (a', a)"] by blast show ?thesis proof - have"f' = ψ (a', a) (φ (a', a) f')" using Ya.ide_a a' f' Hom.ψ_φ by simp alsohave"... = ψ (a', a) (Ψ.FUN a' (ι χ'))" using Ya.ide_a a' Hom.ψ_φ A 3by simp finallyshow ?thesis by blast qed qed qed qed
interpretation χ: limit_cone J C D a χ proof show"∧a' χ'. D.cone a' χ' ==>∃!f. «f : a' → a¬∧ D.cones_map f χ = χ'" proof - fix a' χ' assume1: "D.cone a' χ'" show"∃!f. «f : a' → a¬∧ D.cones_map f χ = χ'" proof show"«ψ (a', a) (Ψ.FUN a' (ι χ')) : a' → a¬∧ D.cones_map (ψ (a', a) (Ψ.FUN a' (ι χ'))) χ = χ'" using1 χ_is_universal by blast show"∧f. «f : a' → a¬∧ D.cones_map f χ = χ' ==> f = ψ (a', a) (Ψ.FUN a' (ι χ'))" using1 χ_is_universal by blast qed qed qed
lemma χ_is_limit_cone: shows"D.limit_cone a χ" ..
lemma induces_limit_situation: shows"limit_situation J C D S φ ι a Φ χ" proof show"χ = χ"by simp fix a' assume a': "Cop.ide a'" let ?F = "λx. ι (D.cones_map (ψ (a', a) x) χ)" show"Φ a' = S.mkArr (Hom.set (a', a)) (ι ` D.cones a') ?F" proof - have1: "«Φ a' : S.mkIde (Hom.set (a', a)) →S S.mkIde (ι ` D.cones a')¬" using a' Cones.map_ide Ya.ide_a by auto moreoverhave"Φ.DOM a' = Hom.set (a', a)" using1 Hom.set_subset_Univ a' Ya.ide_a Hom.set_map by simp moreoverhave"Φ.COD a' = ι ` D.cones a'" using a' Cones_SET_eq_ι_img_cones by fastforce ultimatelyhave2: "Φ a' = S.mkArr (Hom.set (a', a)) (ι ` D.cones a') (Φ.FUN a')" using S.mkArr_Fun [of "Φ a'"] by fastforce alsohave"... = S.mkArr (Hom.set (a', a)) (ι ` D.cones a') ?F" proof show"S.arr (S.mkArr (Hom.set (a', a)) (ι ` D.cones a') (Φ.FUN a'))" using12by auto show"∧x. x ∈ Hom.set (a', a) ==> Φ.FUN a' x = ?F x" proof - fix x assume x: "x ∈ Hom.set (a', a)" hence ψx: "«ψ (a', a) x : a' → a¬" using a' Ya.ide_a Hom.ψ_mapsto by auto show"Φ.FUN a' x = ?F x" proof - have"Φ.FUN a' x = Cones.FUN (ψ (a', a) x) (ι χ)" using a' x Φ_FUN_simp by simp alsohave"... = restrict (ι o D.cones_map (ψ (a', a) x) o o) (ι ` D.cones a) (ι χ)" using ψx Cones.map_simp Cones.preserves_arr [of "ψ (a', a) x"] S.Fun_mkArr by (elim C.in_homE, auto) alsohave"... = ?F x"using cone_χ by simp ultimatelyshow ?thesis by simp qed qed qed finallyshow"Φ a' = S.mkArr (Hom.set (a', a)) (ι ` D.cones a') ?F"by auto qed qed
end
sublocale representation_of_cones_functor ⊆ limit_situation J C D S φ ι a Φ χ using induces_limit_situation by auto
section"Categories with Limits"
context category begin
text‹
A category @{term[source=true] C} has limits of shape @{term J} if every diagram of shape
@{term J} admits a limit cone. ›
definition has_limits_of_shape where"has_limits_of_shape J ≡∀D. diagram J C D ⟶ (∃a χ. limit_cone J C D a χ)"
text‹
A category has limits at a type @{typ 'j} if it has limits of shape @{term J}
for every category @{term J} whose arrows are of type @{typ 'j}. ›
text‹
Whether a category has limits of shape ‹J› truly depends only on the ``shape''
(\emph{i.e.}~isomorphism class) of ‹J› and not on details of its construction. ›
lemma has_limits_preserved_by_isomorphism: assumes"has_limits_of_shape J"and"isomorphic_categories J J'" shows"has_limits_of_shape J'" proof - interpret J: category J using assms(2) isomorphic_categories_def isomorphic_categories_axioms_def by auto interpret J': category J' using assms(2) isomorphic_categories_def isomorphic_categories_axioms_def by auto from assms(2) obtain φ ψ whereIF: "inverse_functors J' J φ ψ" using isomorphic_categories_def isomorphic_categories_axioms_def
inverse_functors_sym by blast interpretIF: inverse_functors J' J φ ψ usingIFby auto have ψφ: "ψ o φ = J.map"usingIF.inv by metis have φψ: "φ o ψ = J'.map"usingIF.inv' by metis have"∧D'. diagram J' C D' ==>∃a χ. limit_cone J' C D' a χ" proof - fix D' assume D': "diagram J' C D'" interpret D': diagram J' C D' using D' by auto interpret D: composite_functor J J' C φ D' .. interpret D: diagram J C ‹D' o φ› .. have D: "diagram J C (D' o φ)" .. from assms(1) obtain a χ where χ: "D.limit_cone a χ" using D has_limits_of_shape_def by blast interpret χ: limit_cone J C ‹D' o φ› a χ using χ by auto interpret A': constant_functor J' C a using χ.ide_apex by (unfold_locales, auto) have χoψ: "cone J' C (D' o φ o ψ) a (χ o ψ)" using comp_cone_functor IF.G.functor_axioms χ.cone_axioms by fastforce hence χoψ: "cone J' C D' a (χ o ψ)" using φψ by (metis D'.functor_axioms Fun.comp_assoc comp_functor_identity) interpret χoψ: cone J' C D' a ‹χ o ψ›using χoψ by auto interpret χoψ: limit_cone J' C D' a ‹χ o ψ› proof fix a' χ' assume χ': "D'.cone a' χ'" interpret χ': cone J' C D' a' χ' using χ' by auto have χ'oφ: "cone J C (D' o φ) a' (χ' o φ)" using χ' comp_cone_functor IF.F.functor_axioms by fastforce interpret χ'oφ: cone J C ‹D' o φ› a' ‹χ' o φ›using χ'oφ by auto have"cone J C (D' o φ) a' (χ' o φ)" .. hence1: "∃!f. «f : a' → a¬∧ D.cones_map f χ = χ' o φ" using χ.is_universal by simp show"∃!f. «f : a' → a¬∧ D'.cones_map f (χ o ψ) = χ'" proof let ?f = "THE f. «f : a' → a¬∧ D.cones_map f χ = χ' o φ" have f: "«?f : a' → a¬∧ D.cones_map ?f χ = χ' o φ" using1 theI' [of "λf. «f : a' → a¬∧ D.cones_map f χ = χ' o φ"] by blast have f_in_hom: "«?f : a' → a¬"using f by blast have"D'.cones_map ?f (χ o ψ) = χ'" proof fix j' have"¬J'.arr j' ==> D'.cones_map ?f (χ o ψ) j' = χ' j'" proof - assume j': "¬J'.arr j'" have"D'.cones_map ?f (χ o ψ) j' = null" using j' f_in_hom χoψ by fastforce thus ?thesis using j' χ'.extensionality by simp qed moreoverhave"J'.arr j' ==> D'.cones_map ?f (χ o ψ) j' = χ' j'" proof - assume j': "J'.arr j'" have"D'.cones_map ?f (χ o ψ) j' = χ (ψ j') ⋅ ?f" using j' f χoψ by fastforce alsohave"... = D.cones_map ?f χ (ψ j')" using j' f_in_hom χ χ.is_cone by fastforce alsohave"... = χ' j'" using j' f χ φψ Fun.comp_def J'.map_simp by metis finallyshow"D'.cones_map ?f (χ o ψ) j' = χ' j'"by auto qed ultimatelyshow"D'.cones_map ?f (χ o ψ) j' = χ' j'"by blast qed thus"«?f : a' → a¬∧ D'.cones_map ?f (χ o ψ) = χ'"using f by auto fix f' assume f': "«f' : a' → a¬∧ D'.cones_map f' (χ o ψ) = χ'" have"D.cones_map f' χ = χ' o φ" proof fix j have"¬J.arr j ==> D.cones_map f' χ j = (χ' o φ) j" using f' χ χ'oφ.extensionality χ.is_cone mem_Collect_eq restrict_apply by auto moreoverhave"J.arr j ==> D.cones_map f' χ j = (χ' o φ) j" proof - assume j: "J.arr j" have"D.cones_map f' χ j = C (χ j) f'" using j f' χ.is_cone by auto alsohave"... = C ((χ o ψ) (φ j)) f'" using j f' ψφ by (metis comp_apply J.map_simp) alsohave"... = D'.cones_map f' (χ o ψ) (φ j)" using j f' χoψ by fastforce alsohave"... = (χ' o φ) j" using j f' by auto finallyshow"D.cones_map f' χ j = (χ' o φ) j"by auto qed ultimatelyshow"D.cones_map f' χ j = (χ' o φ) j"by blast qed hence"«f' : a' → a¬∧ D.cones_map f' χ = χ' o φ" using f' by auto moreoverhave"∧P x x'. (∃!x. P x) ∧ P x ∧ P x' ==> x = x'" by auto ultimatelyshow"f' = ?f"using1 f by blast qed qed have"limit_cone J' C D' a (χ o ψ)" .. thus"∃a χ. limit_cone J' C D' a χ"by blast qed thus ?thesis using has_limits_of_shape_def by auto qed
end
subsection"Diagonal Functors"
text‹
The existence of limits can also be expressed in terms of adjunctions: a category @{term C}
has limits of shape @{term J} if the diagonal functor taking each object @{term a}
in @{term C} to the constant-@{term a} diagram and each arrow ‹f ∈ C.hom a a'›
to the constant-@{term f} natural transformation between diagrams is a left adjoint functor. ›
locale diagonal_functor =
C: category C +
J: category J +
J_C: functor_category J C for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) begin
definition map :: "'c ==> ('j, 'c) J_C.arr" where"map f = (if C.arr f then J_C.MkArr (constant_functor.map J C (C.dom f)) (constant_functor.map J C (C.cod f)) (constant_transformation.map J C f) else J_C.null)"
lemma is_functor: shows"functor C J_C.comp map" proof fix f show"¬ C.arr f ==> local.map f = J_C.null" using map_def by simp assume f: "C.arr f" interpret Dom_f: constant_functor J C ‹C.dom f› using f by (unfold_locales, auto) interpret Cod_f: constant_functor J C ‹C.cod f› using f by (unfold_locales, auto) interpret Fun_f: constant_transformation J C f using f by (unfold_locales, auto) show1: "J_C.arr (map f)" using f map_def by (simp add: Fun_f.natural_transformation_axioms) show"J_C.dom (map f) = map (C.dom f)" proof - have"constant_transformation J C (C.dom f)" using f by unfold_locales auto hence"constant_transformation.map J C (C.dom f) = Dom_f.map" using Dom_f.map_def constant_transformation.map_def [of J C "C.dom f"] by auto thus ?thesis using f 1by (simp add: map_def J_C.dom_char) qed show"J_C.cod (map f) = map (C.cod f)" proof - have"constant_transformation J C (C.cod f)" using f by unfold_locales auto hence"constant_transformation.map J C (C.cod f) = Cod_f.map" using Cod_f.map_def constant_transformation.map_def [of J C "C.cod f"] by auto thus ?thesis using f 1by (simp add: map_def J_C.cod_char) qed next fix f g assume g: "C.seq g f" have f: "C.arr f"using g by auto interpret Dom_f: constant_functor J C ‹C.dom f› using f by unfold_locales auto interpret Cod_f: constant_functor J C ‹C.cod f› using f by unfold_locales auto interpret Fun_f: constant_transformation J C f using f by unfold_locales auto interpret Cod_g: constant_functor J C ‹C.cod g› using g by unfold_locales auto interpret Fun_g: constant_transformation J C g using g by unfold_locales auto interpret Fun_g: natural_transformation J C Cod_f.map Cod_g.map Fun_g.map apply unfold_locales using f g C.seqE [of g f] C.comp_arr_dom C.comp_cod_arr Fun_g.extensionality by auto interpret Fun_fg: vertical_composite
J C Dom_f.map Cod_f.map Cod_g.map Fun_f.map Fun_g.map .. have1: "J_C.arr (map f)" using f map_def by (simp add: Fun_f.natural_transformation_axioms) show"map (g ⋅ f) = map g ⋅[J,C] map f" proof - have"map (C g f) = J_C.MkArr Dom_f.map Cod_g.map (constant_transformation.map J C (C g f))" using f g map_def by simp alsohave"... = J_C.MkArr Dom_f.map Cod_g.map (λj. if J.arr j then C g f else C.null)" proof - have"constant_transformation J C (g ⋅ f)" using g by unfold_locales auto thus ?thesis using constant_transformation.map_def by metis qed alsohave"... = J_C.comp (J_C.MkArr Cod_f.map Cod_g.map Fun_g.map) (J_C.MkArr Dom_f.map Cod_f.map Fun_f.map)" proof - have"J_C.MkArr Cod_f.map Cod_g.map Fun_g.map ⋅[J,C] J_C.MkArr Dom_f.map Cod_f.map Fun_f.map = J_C.MkArr Dom_f.map Cod_g.map Fun_fg.map" using J_C.comp_char J_C.comp_MkArr Fun_f.natural_transformation_axioms
Fun_g.natural_transformation_axioms by blast alsohave"... = J_C.MkArr Dom_f.map Cod_g.map (λj. if J.arr j then g ⋅ f else C.null)" using Fun_fg.extensionality Fun_fg.map_simp_2 by auto finallyshow ?thesis by auto qed alsohave"... = map g ⋅[J,C] map f" using f g map_def by fastforce finallyshow ?thesis by auto qed qed
sublocale"functor" C J_C.comp map using is_functor by auto
text‹
The objects of ‹[J, C]› correspond bijectively to diagrams of shape @{term J}
in @{term C}. ›
lemma ide_determines_diagram: assumes"J_C.ide d" shows"diagram J C (J_C.Map d)"and"J_C.MkIde (J_C.Map d) = d" proof - interpret δ: natural_transformation J C ‹J_C.Map d›‹J_C.Map d›‹J_C.Map d› using assms J_C.ide_char J_C.arr_MkArr by fastforce interpret D: "functor" J C ‹J_C.Map d› .. show"diagram J C (J_C.Map d)" .. show"J_C.MkIde (J_C.Map d) = d" using assms J_C.ide_char by (metis J_C.ideD(1) J_C.MkArr_Map) qed
lemma diagram_determines_ide: assumes"diagram J C D" shows"J_C.ide (J_C.MkIde D)"and"J_C.Map (J_C.MkIde D) = D" proof - interpret D: diagram J C D using assms by auto show"J_C.ide (J_C.MkIde D)"using J_C.ide_char using D.functor_axioms J_C.ide_MkIde by auto thus"J_C.Map (J_C.MkIde D) = D" using J_C.in_homE by simp qed
lemma bij_betw_ide_diagram: shows"bij_betw J_C.Map (Collect J_C.ide) (Collect (diagram J C))" proof (intro bij_betwI) show"J_C.Map ∈ Collect J_C.ide → Collect (diagram J C)" using ide_determines_diagram by blast show"J_C.MkIde ∈ Collect (diagram J C) → Collect J_C.ide" using diagram_determines_ide by blast show"∧d. d ∈ Collect J_C.ide ==> J_C.MkIde (J_C.Map d) = d" using ide_determines_diagram by blast show"∧D. D ∈ Collect (diagram J C) ==> J_C.Map (J_C.MkIde D) = D" using diagram_determines_ide by blast qed
text‹
Arrows from from the diagonal functor correspond bijectively to cones. ›
lemma arrow_determines_cone: assumes"J_C.ide d"and"arrow_from_functor C J_C.comp map a d x" shows"cone J C (J_C.Map d) a (J_C.Map x)" and"J_C.MkArr (constant_functor.map J C a) (J_C.Map d) (J_C.Map x) = x" proof - interpret D: diagram J C ‹J_C.Map d› using assms ide_determines_diagram by auto interpret x: arrow_from_functor C J_C.comp map a d x using assms by auto interpret A: constant_functor J C a using x.arrow by (unfold_locales, auto) interpret α: constant_transformation J C a using x.arrow by (unfold_locales, auto) have Dom_x: "J_C.Dom x = A.map" using J_C.in_hom_char map_def x.arrow by force have Cod_x: "J_C.Cod x = J_C.Map d" using x.arrow by auto interpret χ: natural_transformation J C A.map ‹J_C.Map d›‹J_C.Map x› using x.arrow J_C.arr_char [of x] Dom_x Cod_x by force show"D.cone a (J_C.Map x)" .. show"J_C.MkArr A.map (J_C.Map d) (J_C.Map x) = x" using x.arrow Dom_x Cod_x χ.natural_transformation_axioms by (intro J_C.arr_eqI, auto) qed
lemma cone_determines_arrow: assumes"J_C.ide d"and"cone J C (J_C.Map d) a χ" shows"arrow_from_functor C J_C.comp map a d (J_C.MkArr (constant_functor.map J C a) (J_C.Map d) χ)" and"J_C.Map (J_C.MkArr (constant_functor.map J C a) (J_C.Map d) χ) = χ" proof - interpret χ: cone J C ‹J_C.Map d› a χ using assms(2) by auto let ?x = "J_C.MkArr χ.A.map (J_C.Map d) χ" interpret x: arrow_from_functor C J_C.comp map a d ?x proof have"«J_C.MkArr χ.A.map (J_C.Map d) χ : J_C.MkIde χ.A.map →[J,C] J_C.MkIde (J_C.Map d)¬" using χ.natural_transformation_axioms by auto moreoverhave"J_C.MkIde χ.A.map = map a" using χ.A.value_is_ide map_def χ.A.map_def C.ide_char by (metis (no_types, lifting) J_C.dom_MkArr preserves_arr preserves_dom) moreoverhave"J_C.MkIde (J_C.Map d) = d" using assms ide_determines_diagram(2) by simp ultimatelyshow"C.ide a ∧«J_C.MkArr χ.A.map (J_C.Map d) χ : map a →[J,C] d¬" using χ.A.value_is_ide by simp qed show"arrow_from_functor C J_C.comp map a d ?x" .. show"J_C.Map (J_C.MkArr (constant_functor.map J C a) (J_C.Map d) χ) = χ" by (simp add: χ.natural_transformation_axioms) qed
text‹
Transforming a cone by composing at the apex with an arrow @{term g} corresponds,
via the preceding bijections, to composition in ‹[J, C]› with the image of @{term g}
under the diagonal functor. ›
lemma cones_map_is_composition: assumes"«g : a' → a¬"and"cone J C D a χ" shows"J_C.MkArr (constant_functor.map J C a') D (diagram.cones_map J C D g χ) = J_C.MkArr (constant_functor.map J C a) D χ ⋅[J,C] map g" proof - interpret A: constant_transformation J C a using assms(1) by (unfold_locales, auto) interpret χ: cone J C D a χ using assms(2) by auto have cone_χ: "cone J C D a χ" .. interpret A': constant_transformation J C a' using assms(1) by (unfold_locales, auto) let ?χ' = "χ.D.cones_map g χ" interpret χ': cone J C D a' ?χ' using assms(1) cone_χ χ.D.cones_map_mapsto by blast let ?x = "J_C.MkArr χ.A.map D χ" let ?x' = "J_C.MkArr χ'.A.map D ?χ'" show"?x' = J_C.comp ?x (map g)" proof (intro J_C.arr_eqI) have x: "J_C.arr ?x" using χ.natural_transformation_axioms J_C.arr_char [of ?x] by simp show x': "J_C.arr ?x'" using χ'.natural_transformation_axioms J_C.arr_char [of ?x'] by simp have3: "«?x : map a →[J,C] J_C.MkIde D¬" using χ.D.diagram_axioms arrow_from_functor.arrow cone_χ cone_determines_arrow(1)
diagram_determines_ide(1) by fastforce have4: "«?x' : map a' →[J,C] J_C.MkIde D¬" by (metis (no_types, lifting) J_C.Dom.simps(1) J_C.Dom_cod J_C.Map_cod
J_C.cod_MkArr χ'.cone_axioms arrow_from_functor.arrow category.ide_cod
cone_determines_arrow(1) functor_def is_functor x) have seq_xg: "J_C.seq ?x (map g)" using assms(1) 3 preserves_hom [of g] by (intro J_C.seqI', auto) show2: "J_C.seq ?x (map g)" using seq_xg J_C.seqI' by blast show"J_C.Dom ?x' = J_C.Dom (?x ⋅[J,C] map g)" proof - have"J_C.Dom ?x' = J_C.Dom (J_C.dom ?x')" using x' J_C.Dom_dom by simp alsohave"... = J_C.Dom (map a')" using4by force alsohave"... = J_C.Dom (J_C.dom (?x ⋅[J,C] map g))" using assms(1) 2by auto alsohave"... = J_C.Dom (?x ⋅[J,C] map g)" using seq_xg J_C.Dom_dom J_C.seqI' by blast finallyshow ?thesis by auto qed show"J_C.Cod ?x' = J_C.Cod (?x ⋅[J,C] map g)" proof - have"J_C.Cod ?x' = J_C.Cod (J_C.cod ?x')" using x' J_C.Cod_cod by simp alsohave"... = J_C.Cod (J_C.MkIde D)" using4by force alsohave"... = J_C.Cod (J_C.cod (?x ⋅[J,C] map g))" using23 J_C.cod_comp J_C.in_homE by metis alsohave"... = J_C.Cod (?x ⋅[J,C] map g)" using seq_xg J_C.Cod_cod J_C.seqI' by blast finallyshow ?thesis by auto qed show"J_C.Map ?x' = J_C.Map (?x ⋅[J,C] map g)" proof - interpret g: constant_transformation J C g apply unfold_locales using assms(1) by auto interpret χog: vertical_composite J C A'.map χ.A.map D g.map χ using assms(1) C.comp_arr_dom C.comp_cod_arr A'.extensionality g.extensionality apply (unfold_locales, auto) by (elim J.seqE, auto) have"J_C.Map (?x ⋅[J,C] map g) = χog.map" using assms(1) 2 J_C.comp_char map_def by auto alsohave"... = J_C.Map ?x'" using x' χog.map_def J_C.arr_char [of ?x'] natural_transformation.extensionality
assms(1) cone_χ χog.map_simp_2 by fastforce finallyshow ?thesis by auto qed qed qed
text‹
Coextension along an arrow from a functor is equivalent to a transformation of cones. ›
lemma coextension_iff_cones_map: assumes x: "arrow_from_functor C J_C.comp map a d x" and g: "«g : a' → a¬" and x': "«x' : map a' →[J,C] d¬" shows"arrow_from_functor.is_coext C J_C.comp map a x a' x' g ⟷ J_C.Map x' = diagram.cones_map J C (J_C.Map d) g (J_C.Map x)" proof - interpret x: arrow_from_functor C J_C.comp map a d x using assms by auto interpret A': constant_functor J C a' using assms(2) by (unfold_locales, auto) have x': "arrow_from_functor C J_C.comp map a' d x'" using A'.value_is_ide assms(3) by (unfold_locales, blast) have d: "J_C.ide d"using J_C.ide_cod x.arrow by blast let ?D = "J_C.Map d" let ?χ = "J_C.Map x" let ?χ' = "J_C.Map x'" interpret D: diagram J C ?D using ide_determines_diagram J_C.ide_cod x.arrow by blast interpret χ: cone J C ?D a ?χ using assms(1) d arrow_determines_cone by simp interpret γ: constant_transformation J C g using g χ.ide_apex by (unfold_locales, auto) interpret χog: vertical_composite J C A'.map χ.A.map ?D γ.map ?χ using g C.comp_arr_dom C.comp_cod_arr γ.extensionality by (unfold_locales, auto) show ?thesis proof assume0: "x.is_coext a' x' g" show"?χ' = D.cones_map g ?χ" proof - have1: "x' = x ⋅[J,C] map g" using0 x.is_coext_def by blast hence"?χ' = J_C.Map x'" using0 x.is_coext_def by fast moreoverhave"... = D.cones_map g ?χ" proof - have"J_C.MkArr A'.map (J_C.Map d) (D.cones_map g (J_C.Map x)) = x'" proof - have"J_C.MkArr A'.map (J_C.Map d) (D.cones_map g (J_C.Map x)) = x ⋅[J,C] map g" using d g cones_map_is_composition arrow_determines_cone(2) χ.cone_axioms
x.arrow_from_functor_axioms by auto thus ?thesis by (metis 1) qed moreoverhave"J_C.arr (J_C.MkArr A'.map (J_C.Map d) (D.cones_map g (J_C.Map x)))" using1 d g cones_map_is_composition preserves_arr arrow_determines_cone(2)
χ.cone_axioms x.arrow_from_functor_axioms assms(3) by auto ultimatelyshow ?thesis by auto qed ultimatelyshow ?thesis by blast qed next assume X': "?χ' = D.cones_map g ?χ" show"x.is_coext a' x' g" proof - have4: "J_C.seq x (map g)" using g x.arrow mem_Collect_eq preserves_arr preserves_cod by (elim C.in_homE, auto) hence1: "x ⋅[J,C] map g = J_C.MkArr (J_C.Dom (map g)) (J_C.Cod x) (vertical_composite.map J C (J_C.Map (map g)) ?χ)" using J_C.comp_char [of x "map g"] by simp have2: "vertical_composite.map J C (J_C.Map (map g)) ?χ = χog.map" by (simp add: map_def γ.value_is_arr γ.natural_transformation_axioms) have3: "... = D.cones_map g ?χ" using g χog.map_simp_2 χ.cone_axioms χog.extensionality by auto have"J_C.MkArr A'.map ?D ?χ' = J_C.comp x (map g)" proof - have f1: "A'.map = J_C.Dom (map g)" using γ.natural_transformation_axioms map_def g by auto have"J_C.Map d = J_C.Cod x" using x.arrow by auto thus ?thesis using f1 X' 123by argo qed moreoverhave"J_C.MkArr A'.map ?D ?χ' = x'" using d x' arrow_determines_cone by blast ultimatelyshow ?thesis using g x.is_coext_def by simp qed qed qed
end
locale right_adjoint_to_diagonal_functor =
C: category C +
J: category J +
J_C: functor_category J C +
Δ: diagonal_functor J C + "functor" J_C.comp C G +
Adj: meta_adjunction J_C.comp C Δ.map G φ ψ for J :: "'j comp" (infixr‹⋅J›55) and C :: "'c comp" (infixr‹⋅›55) and G :: "('j, 'c) functor_category.arr ==> 'c" and φ :: "'c ==> ('j, 'c) functor_category.arr ==> 'c" and ψ :: "('j, 'c) functor_category.arr ==> 'c ==> ('j, 'c) functor_category.arr" + assumes adjoint: "adjoint_functors J_C.comp C Δ.map G" begin
interpretation S: replete_setcat . interpretation Adj: adjunction J_C.comp C S.comp S.setp Adj.φC Adj.φD Δ.map G
φ ψ Adj.η Adj.ε Adj.Φ Adj.Ψ using Adj.induces_adjunction by simp
text‹
A right adjoint @{term G} to a diagonal functor maps each object @{term d} of ‹[J, C]› (corresponding to a diagram @{term D} of shape @{term J} in @{term C}
to an object of @{term C}. This object is the limit object, and the component at @{term d}
of the counit of the adjunction determines the limit cone. ›
lemma gives_limit_cones: assumes"diagram J C D" shows"limit_cone J C D (G (J_C.MkIde D)) (J_C.Map (Adj.ε (J_C.MkIde D)))" proof - interpret D: diagram J C D using assms by auto let ?d = "J_C.MkIde D" let ?a = "G ?d" let ?x = "Adj.ε ?d" let ?χ = "J_C.Map ?x" have"diagram J C D" .. hence1: "J_C.ide ?d"using Δ.diagram_determines_ide by auto hence2: "J_C.Map (J_C.MkIde D) = D" using assms 1 J_C.in_homE Δ.diagram_determines_ide(2) by simp interpret x: terminal_arrow_from_functor C J_C.comp Δ.map ?a ?d ?x apply unfold_locales apply (metis (no_types, lifting) "1" preserves_ide Adj.ε_in_terms_of_ψ
Adj.εo_def Adj.εo_in_hom) by (metis 1 Adj.has_terminal_arrows_from_functor(1)
terminal_arrow_from_functor.is_terminal) have3: "arrow_from_functor C J_C.comp Δ.map ?a ?d ?x" .. interpret χ: cone J C D ?a ?χ using123 Δ.arrow_determines_cone [of ?d] by auto have cone_χ: "D.cone ?a ?χ" .. interpret χ: limit_cone J C D ?a ?χ proof fix a' χ' assume cone_χ': "D.cone a' χ'" interpret χ': cone J C D a' χ' using cone_χ' by auto let ?x' = "J_C.MkArr χ'.A.map D χ'" interpret x': arrow_from_functor C J_C.comp Δ.map a' ?d ?x' using12by (metis Δ.cone_determines_arrow(1) cone_χ') have"arrow_from_functor C J_C.comp Δ.map a' ?d ?x'" .. hence4: "∃!g. x.is_coext a' ?x' g" using x.is_terminal by simp have5: "∧g. «g : a' →C ?a¬==> x.is_coext a' ?x' g ⟷ D.cones_map g ?χ = χ'" using Δ.coextension_iff_cones_map x'.arrow x.arrow_from_functor_axioms by auto have6: "∧g. x.is_coext a' ?x' g ==>«g : a' →C ?a¬" using x.is_coext_def by simp show"∃!g. «g : a' →C ?a¬∧ D.cones_map g ?χ = χ'" proof - have"∃g. «g : a' →C ?a¬∧ D.cones_map g ?χ = χ'" using456by meson thus ?thesis using456by blast qed qed show"D.limit_cone ?a ?χ" .. qed
corollary gives_limits: assumes"diagram J C D" shows"diagram.has_as_limit J C D (G (J_C.MkIde D))" using assms gives_limit_cones by fastforce
end
lemma (in category) limits_are_isomorphic: fixes J :: "'j comp" assumes"limit_cone J C D a χ"and"limit_cone J C D a' χ'" shows"isomorphic a a'"and"iso (limit_cone.induced_arrow J C D a χ a' χ')" proof - interpret J: category J using assms(1) limit_cone.axioms(2) by metis interpret C: category C using assms(1) limit_cone.axioms(1) by metis interpret D: diagram J C D using assms(1) limit_cone.axioms(3) by metis interpret χ: limit_cone J C D a χ using assms(1) by blast interpret χ': limit_cone J C D a' χ' using assms(2) by blast have1: "∃!f. «f : a → a'¬∧ D.cones_map f χ' = χ" using χ'.is_universal [of a χ] χ.cone_axioms by simp have2: "∃!g. «g : a' → a¬∧ D.cones_map g χ = χ'" using χ.is_universal [of a' χ'] χ'.cone_axioms by simp
define f where"f = χ'.induced_arrow a χ"
define g where"g = χ.induced_arrow a' χ'" have f: "«f : a → a'¬∧ D.cones_map f χ' = χ" using f_def χ'.induced_arrowI(1-2) χ.is_cone by blast have g: "«g : a' → a¬∧ D.cones_map g χ = χ'" using g_def χ.induced_arrowI(1-2) χ'.is_cone by blast have *: "inverse_arrows f g" proof show"ide (g ⋅ f)" proof - have"g ⋅ f = a" proof - have"∃!h. «h : a → a¬∧ D.cones_map h χ = χ" using χ.is_universal [of a χ] χ.cone_axioms by blast moreoverhave"«g ⋅ f : a → a¬" using f g by blast moreoverhave"D.cones_map (g ⋅ f) χ = χ" proof fix j :: 'j show"D.cones_map (g ⋅ f) χ j = χ j" proof (cases "J.arr j") show"¬ J.arr j ==> ?thesis" using f g χ.cone_axioms χ.extensionality by fastforce assume j: "J.arr j" have"D.cone (dom g) (D.cones_map g χ)" using g D.cones_map_mapsto χ.cone_axioms by blast thus ?thesis using f g χ.cone_axioms D.cones_map_comp [of g f] by fastforce qed qed moreoverhave"«a : a → a¬" using χ.ide_apex by auto moreoverhave"D.cones_map a χ = χ" using f χ.cone_axioms D.cones_map_ide by blast ultimatelyshow ?thesis by blast qed thus ?thesis using χ.ide_apex by blast qed show"ide (f ⋅ g)" proof - have"f ⋅ g = a'" proof - have"∃!h. «h : a' → a'¬∧ D.cones_map h χ' = χ'" using χ'.is_universal [of a' χ'] χ'.cone_axioms by blast moreoverhave"«f ⋅ g : a' → a'¬" using f g by blast moreoverhave"D.cones_map (f ⋅ g) χ' = χ'" proof fix j :: 'j show"D.cones_map (f ⋅ g) χ' j = χ' j" proof (cases "J.arr j") show"¬ J.arr j ==> ?thesis" using f g χ'.cone_axioms χ'.extensionality by fastforce assume j: "J.arr j" have"D.cone (dom f) (D.cones_map f χ')" using f D.cones_map_mapsto χ'.cone_axioms by blast thus ?thesis using f g χ'.cone_axioms D.cones_map_comp [of f g] by fastforce qed qed moreoverhave"«a' : a' → a'¬" using χ'.ide_apex by auto moreoverhave"D.cones_map a' χ' = χ'" using g χ'.cone_axioms D.cones_map_ide by blast ultimatelyshow ?thesis by blast qed thus ?thesis using χ'.ide_apex by blast qed qed show"isomorphic a a'" using * f g by blast show"iso (χ.induced_arrow a' χ')" using * g_def by blast qed
lemma (in category) has_limits_iff_left_adjoint_diagonal: assumes"category J" shows"has_limits_of_shape J ⟷ left_adjoint_functor C (functor_category.comp J C) (diagonal_functor.map J C)" proof - interpret J: category J using assms by auto interpret J_C: functor_category J C .. interpret Δ: diagonal_functor J C .. show ?thesis proof assume A: "left_adjoint_functor C J_C.comp Δ.map" interpret Δ: left_adjoint_functor C J_C.comp Δ.map using A by auto interpret Adj: meta_adjunction J_C.comp C Δ.map Δ.G Δ.φ Δ.ψ using Δ.induces_meta_adjunction by auto have1: "adjoint_functors J_C.comp C Δ.map Δ.G" using adjoint_functors_def Δ.induces_meta_adjunction by blast interpret G: right_adjoint_to_diagonal_functor J C Δ.G Δ.φ Δ.ψ using1by unfold_locales auto show"has_limits_of_shape J" using A G.gives_limits has_limits_of_shape_def by blast next text‹
If @{term "has_limits J"}, then every diagram @{term D} from @{term J} to
@{term[source=true] C} has a limit cone.
This means that, for every object @{term d} of the functor category ‹[J, C]›, there exists an object @{term a} of @{term C} and a terminal arrow from ‹Δ a› to @{term d} in ‹[J, C]›. The terminal arrow is given by the
limit cone. › assume A: "has_limits_of_shape J" show"left_adjoint_functor C J_C.comp Δ.map" proof fix d assume D: "J_C.ide d" interpret D: diagram J C ‹J_C.Map d› using D Δ.ide_determines_diagram by auto let ?D = "J_C.Map d" have"diagram J C (J_C.Map d)" .. from this obtain a χ where limit: "limit_cone J C ?D a χ" using A has_limits_of_shape_def by blast interpret A: constant_functor J C a using limit by (simp add: Limit.cone_def limit_cone_def) interpret χ: limit_cone J C ?D a χ using limit by simp have cone_χ: "cone J C ?D a χ" .. let ?x = "J_C.MkArr A.map ?D χ" interpret x: arrow_from_functor C J_C.comp Δ.map a d ?x using D cone_χ Δ.cone_determines_arrow by auto have"terminal_arrow_from_functor C J_C.comp Δ.map a d ?x" proof show"∧a' x'. arrow_from_functor C J_C.comp Δ.map a' d x' ==>∃!g. x.is_coext a' x' g" proof - fix a' x' assume x': "arrow_from_functor C J_C.comp Δ.map a' d x'" interpret x': arrow_from_functor C J_C.comp Δ.map a' d x' using x' by auto interpret A': constant_functor J C a' by (unfold_locales, simp add: x'.arrow) let ?χ' = "J_C.Map x'" interpret χ': cone J C ?D a' ?χ' using D x' Δ.arrow_determines_cone by auto have cone_χ': "cone J C ?D a' ?χ'" .. let ?g = "χ.induced_arrow a' ?χ'" show"∃!g. x.is_coext a' x' g" proof show"x.is_coext a' x' ?g" proof (unfold x.is_coext_def) have1: "«?g : a' → a¬∧ D.cones_map ?g χ = ?χ'" using χ.induced_arrow_def χ.is_universal cone_χ'
theI' [of "λf. «f : a' → a¬∧ D.cones_map f χ = ?χ'"] by presburger hence2: "x' = ?x ⋅[J,C] Δ.map ?g" proof - have"x' = J_C.MkArr A'.map ?D ?χ'" using D Δ.arrow_determines_cone(2) x'.arrow_from_functor_axioms by auto thus ?thesis using1 cone_χ Δ.cones_map_is_composition [of ?g a' a ?D χ] by simp qed show"«?g : a' → a¬∧ x' = ?x ⋅[J,C] Δ.map ?g" using12by auto qed next fix g assume X: "x.is_coext a' x' g" show"g = ?g" proof - have"«g : a' → a¬∧ D.cones_map g χ = ?χ'" proof show G: "«g : a' → a¬"using X x.is_coext_def by blast show"D.cones_map g χ = ?χ'" proof - have"?χ' = J_C.Map (?x ⋅[J,C] Δ.map g)" using X x.is_coext_def [of a' x' g] by fast alsohave"... = D.cones_map g χ" proof - interpret map_g: constant_transformation J C g using G by (unfold_locales, auto) interpret χ': vertical_composite J C
map_g.F.map A.map ‹χ.Φ.Ya.Cop_S.Map d›
map_g.map χ proof (intro_locales) have"map_g.G.map = A.map" using G by blast thus"natural_transformation_axioms J (⋅) map_g.F.map A.map map_g.map" using map_g.natural_transformation_axioms by (simp add: natural_transformation_def) qed have"J_C.Map (?x ⋅[J,C] Δ.map g) = vertical_composite.map J C map_g.map χ" proof - have"J_C.seq ?x (Δ.map g)" using G x.arrow by auto thus ?thesis using G Δ.map_def J_C.Map_comp' [of ?x "Δ.map g"] by auto qed alsohave"... = D.cones_map g χ" using G cone_χ χ'.map_def map_g.map_def χ.naturality2 χ'.map_simp_2 by auto finallyshow ?thesis by blast qed finallyshow ?thesis by auto qed qed thus ?thesis using cone_χ' χ.is_universal χ.induced_arrow_def
theI_unique [of "λg. «g : a' → a¬∧ D.cones_map g χ = ?χ'" g] by presburger qed qed qed qed thus"∃a x. terminal_arrow_from_functor C J_C.comp Δ.map a d x"by auto qed qed qed
section"Right Adjoint Functors Preserve Limits"
context right_adjoint_functor begin
lemma preserves_limits: fixes J :: "'j comp" assumes"diagram J C E"and"diagram.has_as_limit J C E a" shows"diagram.has_as_limit J D (G o E) (G a)" proof - text‹
From the assumption that @{term E} has a limit, obtain a limit cone @{term χ}. › interpret J: category J using assms(1) diagram_def by auto interpret E: diagram J C E using assms(1) by auto from assms(2) obtain χ where χ: "limit_cone J C E a χ"by auto interpret χ: limit_cone J C E a χ using χ by auto have a: "C.ide a"using χ.ide_apex by auto text‹
Form the @{term E}-image ‹GE› of the diagram @{term E}. › interpret GE: composite_functor J C D E G .. interpret GE: diagram J D GE.map .. text‹Let ‹Gχ› be the @{term G}-image of the cone @{term χ},
and note that it is a cone over ‹GE›.› let ?Gχ = "G o χ" interpret Gχ: cone J D GE.map ‹G a› ?Gχ using χ.cone_axioms preserves_cones by blast text‹
Claim that ‹Gχ› is a limit cone for diagram ‹GE›. › interpret Gχ: limit_cone J D GE.map ‹G a› ?Gχ proof text‹
Let @{term κ} be an arbitrary cone over ‹GE›. › fix b κ assume κ: "GE.cone b κ" interpret κ: cone J D GE.map b κ using κ by auto interpret Fb: constant_functor J C ‹F b› apply unfold_locales by (meson F_is_functor κ.ide_apex functor.preserves_ide) interpret Adj: meta_adjunction C D F G φ ψ using induces_meta_adjunction by auto interpret S: replete_setcat . interpret Adj: adjunction C D S.comp S.setp
Adj.φC Adj.φD F G φ ψ Adj.η Adj.ε Adj.Φ Adj.Ψ using Adj.induces_adjunction by simp text‹
For each arrow @{term j} of @{term J}, let @{term "χ' j"} be defined to be
the adjunct of @{term "χ j"}. We claim that @{term χ'} is a cone over @{term E}. › let ?χ' = "λj. if J.arr j then Adj.ε (C.cod (E j)) ⋅C F (κ j) else C.null" have cone_χ': "E.cone (F b) ?χ'" proof show"∧j. ¬J.arr j ==> ?χ' j = C.null"by simp fix j assume j: "J.arr j" show"C.arr (?χ' j)"using j ψ_in_hom by simp show"E j ⋅C ?χ' (J.dom j) = ?χ' j" proof - have"E j ⋅C ?χ' (J.dom j) = (E j ⋅C Adj.ε (E (J.dom j))) ⋅C F (κ (J.dom j))" using j C.comp_assoc by simp alsohave"... = Adj.ε (E (J.cod j)) ⋅C F (κ j)" proof - have"(E j ⋅C Adj.ε (E (J.dom j))) ⋅C F (κ (J.dom j)) = (Adj.ε (C.cod (E j)) ⋅C Adj.FG.map (E j)) ⋅C F (κ (J.dom j))" using j Adj.ε.naturality [of "E j"] by fastforce alsohave"... = Adj.ε (C.cod (E j)) ⋅C Adj.FG.map (E j) ⋅C F (κ (J.dom j))" using C.comp_assoc by simp alsohave"... = Adj.ε (E (J.cod j)) ⋅C F (κ j)" proof - have"Adj.FG.map (E j) ⋅C F (κ (J.dom j)) = F (GE.map j ⋅D κ (J.dom j))" using j by simp hence"Adj.FG.map (E j) ⋅C F (κ (J.dom j)) = F (κ j)" using j κ.naturality1 by metis thus ?thesis using j by simp qed finallyshow ?thesis by auto qed alsohave"... = ?χ' j" using j by simp finallyshow ?thesis by auto qed show"?χ' (J.cod j) ⋅C Fb.map j = ?χ' j" proof - have"?χ' (J.cod j) ⋅C Fb.map j = Adj.ε (E (J.cod j)) ⋅C F (κ (J.cod j))" using j Fb.value_is_ide Adj.ε.preserves_hom C.comp_arr_dom [of "F (κ (J.cod j))"]
C.comp_assoc by simp alsohave"... = Adj.ε (E (J.cod j)) ⋅C F (κ j)" using j κ.naturality1 κ.naturality2 Adj.ε.naturality J.arr_cod_iff_arr by (metis J.cod_cod κ.A.map_simp) alsohave"... = ?χ' j"using j by simp finallyshow ?thesis by auto qed qed text‹
Using the universal property of the limit cone @{term χ}, obtain the unique arrow
@{term f} that transforms @{term χ} into @{term χ'}. › from this χ.is_universal [of "F b" ?χ'] obtain f where f: "«f : F b →C a¬∧ E.cones_map f χ = ?χ'" by auto text‹
Let @{term g} be the adjunct of @{term f}, and show that @{term g} transforms
@{term Gχ} into @{term κ}. › let ?g = "G f ⋅D Adj.η b" have1: "«?g : b →D G a¬"using f κ.ide_apex by fastforce moreoverhave"GE.cones_map ?g ?Gχ = κ" proof fix j have"¬J.arr j ==> GE.cones_map ?g ?Gχ j = κ j" using1 Gχ.cone_axioms κ.extensionality by auto moreoverhave"J.arr j ==> GE.cones_map ?g ?Gχ j = κ j" proof - fix j assume j: "J.arr j" have"GE.cones_map ?g ?Gχ j = G (χ j) ⋅D ?g" using j 1 Gχ.cone_axioms mem_Collect_eq restrict_apply by auto alsohave"... = G (χ j ⋅C f) ⋅D Adj.η b" using j f χ.preserves_hom [of j "J.dom j""J.cod j"] D.comp_assoc by fastforce alsohave"... = G (E.cones_map f χ j) ⋅D Adj.η b" proof - have"χ j ⋅C f = Adj.ε (C.cod (E j)) ⋅C F (κ j)" proof - have"χ j ⋅C f = E.cones_map f χ j" proof - have"E.cone (C.cod f) χ" using f χ.cone_axioms by blast thus ?thesis using χ.extensionality by simp qed alsohave"... = Adj.ε (C.cod (E j)) ⋅C F (κ j)" using j f by simp finallyshow ?thesis by blast qed thus ?thesis using f mem_Collect_eq restrict_apply Adj.F.extensionality by simp qed alsohave"... = (G (Adj.ε (C.cod (E j))) ⋅D Adj.η (D.cod (GE.map j))) ⋅D κ j" using j f Adj.η.naturality [of "κ j"] D.comp_assoc by auto alsohave"... = D.cod (κ j) ⋅D κ j" using j Adj.ηε.triangle_G Adj.ε_in_terms_of_ψ Adj.εo_def
Adj.η_in_terms_of_φ Adj.ηo_def Adj.unit_counit_G by fastforce alsohave"... = κ j" using j D.comp_cod_arr by simp finallyshow"GE.cones_map ?g ?Gχ j = κ j"by metis qed ultimatelyshow"GE.cones_map ?g ?Gχ j = κ j"by auto qed ultimatelyhave"«?g : b →D G a¬∧ GE.cones_map ?g ?Gχ = κ"by auto text‹
It remains to be shown that @{term g} is the unique such arrow.
Given any @{term g'} that transforms @{term Gχ} into @{term κ},
its adjunct transforms @{term χ} into @{term χ'}.
The adjunct of @{term g'} is therefore equal to @{term f},
which implies @{term g'} = @{term g}. › moreoverhave"∧g'. «g' : b →D G a¬∧ GE.cones_map g' ?Gχ = κ ==> g' = ?g" proof - fix g' assume g': "«g' : b →D G a¬∧ GE.cones_map g' ?Gχ = κ" have1: "«ψ a g' : F b →C a¬" using g' a ψ_in_hom by simp have2: "E.cones_map (ψ a g') χ = ?χ'" proof fix j have"¬J.arr j ==> E.cones_map (ψ a g') χ j = ?χ' j" using1 χ.cone_axioms by auto moreoverhave"J.arr j ==> E.cones_map (ψ a g') χ j = ?χ' j" proof - fix j assume j: "J.arr j" have"E.cones_map (ψ a g') χ j = χ j ⋅C ψ a g'" using1 χ.cone_axioms χ.extensionality by auto alsohave"... = (χ j ⋅C Adj.ε a) ⋅C F g'" using j a g' Adj.ψ_in_terms_of_ε C.comp_assoc Adj.ε_defby auto alsohave"... = (Adj.ε (C.cod (E j)) ⋅C F (G (χ j))) ⋅C F g'" using j a g' Adj.ε.naturality [of "χ j"] by simp alsohave"... = Adj.ε (C.cod (E j)) ⋅C F (κ j)" using j a g' Gχ.cone_axioms C.comp_assoc by auto finallyshow"E.cones_map (ψ a g') χ j = ?χ' j"by (simp add: j) qed ultimatelyshow"E.cones_map (ψ a g') χ j = ?χ' j"by auto qed have"ψ a g' = f" proof - have"∃!f. «f : F b →C a¬∧ E.cones_map f χ = ?χ'" using cone_χ' χ.is_universal by simp moreoverhave"«ψ a g' : F b →C a¬∧ E.cones_map (ψ a g') χ = ?χ'" using12by simp ultimatelyshow ?thesis using ex1E [of "λf. «f : F b →C a¬∧ E.cones_map f χ = ?χ'""ψ a g' = f"] using12 Adj.ε.extensionality C.null_is_zero(2) C.ex_un_null χ.cone_axioms f
mem_Collect_eq restrict_apply by blast qed hence"φ b (ψ a g') = φ b f"by auto hence"g' = φ b f"using χ.ide_apex g' by (simp add: φ_ψ) moreoverhave"?g = φ b f"using f Adj.φ_in_terms_of_η κ.ide_apex Adj.η_defby auto ultimatelyshow"g' = ?g"by argo
qed
ultimately show "\<exists>!g. \<guillemotleft>g : b \<rightarrow>\<^sub>D G a\<guillemotright> \<and> GE.cones_map g ?G\<chi> = \<kappa>" by blast
qed
have "GE.limit_cone (G a) ?G\<chi>" ..
thus ?thesis by auto
qed
end
section "Special Kinds of Limits"
subsection "Terminal Objects"
text\<open>
An object of a category @{term C} is a terminal object ifand only if it is a limit of the
empty diagram in @{term C}.
\<close>
locale empty_diagram =
diagram J C D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and D :: "'j \<Rightarrow> 'c" +
assumes is_empty: "\<not>J.arr j" begin
lemma has_as_limit_iff_terminal:
shows "has_as_limit a \<longleftrightarrow> C.terminal a"
proof
assume a: "has_as_limit a"
show "C.terminal a"
proof
have "\<exists>\<chi>. limit_cone a \<chi>" using a by auto
from this obtain \<chi> where \<chi>: "limit_cone a \<chi>" by blast
interpret \<chi>: limit_cone J C D a \<chi> using \<chi> by auto
have cone_\<chi>: "cone a \<chi>" ..
show "C.ide a" using \<chi>.ide_apex by auto
have 1: "\<chi> = (\<lambda>j. C.null)" using is_empty \<chi>.extensionality by auto
show "\<And>a'. C.ide a' \<Longrightarrow> \<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright>"
proof -
fix a'
assume a': "C.ide a'"
interpret A': constant_functor J C a'
apply unfold_locales using a' by auto let ?\<chi>' = "\<lambda>j. C.null"
have cone_\<chi>': "cone a' ?\<chi>'"
using a' is_empty apply unfold_locales by auto
hence "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> cones_map f \<chi> = ?\<chi>'"
using \<chi>.is_universal by force
moreover have "\<And>f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<Longrightarrow> cones_map f \<chi> = ?\<chi>'"
using 1 cone_\<chi> by auto
ultimately show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright>" by blast
qed
qed
next
assume a: "C.terminal a"
show "has_as_limit a"
proof - let ?\<chi> = "\<lambda>j. C.null"
have "C.ide a" using a C.terminal_def by simp
interpret A: constant_functor J C a
apply unfold_locales using \<open>C.ide a\<close> by simp
interpret \<chi>: cone J C D a ?\<chi>
using \<open>C.ide a\<close> is_empty by (unfold_locales, auto)
have cone_\<chi>: "cone a ?\<chi>" ..
have 1: "\<And>a' \<chi>'. cone a' \<chi>' \<Longrightarrow> \<chi>' = (\<lambda>j. C.null)"
proof -
fix a' \<chi>'
assume \<chi>': "cone a' \<chi>'"
interpret \<chi>': cone J C D a' \<chi>' using \<chi>' by auto
show "\<chi>' = (\<lambda>j. C.null)"
using is_empty \<chi>'.extensionality by metis
qed
have "limit_cone a ?\<chi>"
proof
fix a' \<chi>'
assume \<chi>': "cone a' \<chi>'"
have 2: "\<chi>' = (\<lambda>j. C.null)" using 1 \<chi>' by simp
interpret \<chi>': cone J C D a' \<chi>' using \<chi>' by auto
have "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright>" using a C.terminal_def \<chi>'.ide_apex by simp
moreover have "\<And>f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<Longrightarrow> cones_map f ?\<chi> = \<chi>'"
using 12 cones_map_mapsto cone_\<chi> \<chi>'.cone_axioms mem_Collect_eq by blast
ultimately show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> cones_map f (\<lambda>j. C.null) = \<chi>'"
by blast
qed
thus ?thesis by auto
qed
qed
end
subsection "Products"
text\<open>
A \emph{product} in a category @{term C} is a limit of a discrete diagram in @{term C}.
\<close>
locale discrete_diagram =
J: category J +
diagram J C D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and D :: "'j \<Rightarrow> 'c" +
assumes is_discrete: "J.arr = J.ide" begin
abbreviation mkCone
where "mkCone F \<equiv> (\<lambda>j. if J.arr j then F j else C.null)"
lemma cone_mkCone:
assumes "C.ide a"and"\<And>j. J.arr j \<Longrightarrow> \<guillemotleft>F j : a \<rightarrow> D j\<guillemotright>"
shows "cone a (mkCone F)"
proof -
interpret A: constant_functor J C a
using assms(1) by unfold_locales auto
show "cone a (mkCone F)"
using assms(2) is_discrete
apply unfold_locales
apply auto
apply (metis C.in_homE C.comp_cod_arr)
using C.comp_arr_ide by fastforce
qed
lemma mkCone_cone:
assumes "cone a \<pi>"
shows "mkCone \<pi> = \<pi>"
proof -
interpret \<pi>: cone J C D a \<pi>
using assms by auto
show "mkCone \<pi> = \<pi>" using \<pi>.extensionality by auto
qed
end
text\<open>
The following locale defines a discrete diagram in a category @{term C},
given an index set @{term I} and a function @{term D} mapping @{term I}
to objects of @{term C}. Here we obtain the diagram shape @{term J}
using a discrete category construction that allows us to directly identify
the objects of @{term J} with the elements of @{term I}, however this construction
can only be applied incase the set @{term I} is not the universe of its
element type.
\<close>
locale discrete_diagram_from_map =
J: discrete_category I null +
C: category C
for I :: "'i set" and C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and D :: "'i \<Rightarrow> 'c" and null :: 'i +
assumes maps_to_ide: "i \<in> I \<Longrightarrow> C.ide (D i)" begin
definition map
where "map j \<equiv> if J.arr j then D j else C.null"
end
sublocale discrete_diagram_from_map \<subseteq> discrete_diagram J.comp C map
using map_def maps_to_ide J.arr_char J.Null_not_in_Obj J.null_char
by unfold_locales auto
locale product_cone =
J: category J +
C: category C +
D: discrete_diagram J C D +
limit_cone J C D a \<pi>
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and D :: "'j \<Rightarrow> 'c" and a :: 'c and \<pi> :: "'j \<Rightarrow> 'c" begin
lemma is_cone:
shows "D.cone a \<pi>" ..
text\<open>
The following versions of @{prop is_universal} and @{prop induced_arrowI}
from the \<open>limit_cone\<close> locale are specialized to the casein which the
underlying diagram is a product diagram.
\<close>
lemma is_universal':
assumes "C.ide b"and"\<And>j. J.arr j \<Longrightarrow> \<guillemotleft>F j: b \<rightarrow> D j\<guillemotright>"
shows "\<exists>!f. \<guillemotleft>f : b \<rightarrow> a\<guillemotright> \<and> (\<forall>j. J.arr j \<longrightarrow> \<pi> j \<cdot> f = F j)"
proof - let ?\<chi> = "D.mkCone F"
interpret B: constant_functor J C b
using assms(1) by unfold_locales auto
have cone_\<chi>: "D.cone b ?\<chi>"
using assms D.is_discrete D.cone_mkCone by blast
interpret \<chi>: cone J C D b ?\<chi> using cone_\<chi> by auto
have "\<exists>!f. \<guillemotleft>f : b \<rightarrow> a\<guillemotright> \<and> D.cones_map f \<pi> = ?\<chi>"
using cone_\<chi> is_universal by force
moreover have "\<And>f. \<guillemotleft>f : b \<rightarrow> a\<guillemotright> \<Longrightarrow> D.cones_map f \<pi> = ?\<chi> \<longleftrightarrow> (\<forall>j. J.arr j \<longrightarrow> \<pi> j \<cdot> f = F j)"
proof -
fix f
assume f: "\<guillemotleft>f : b \<rightarrow> a\<guillemotright>"
show "D.cones_map f \<pi> = ?\<chi> \<longleftrightarrow> (\<forall>j. J.arr j \<longrightarrow> \<pi> j \<cdot> f = F j)"
proof
assume 1: "D.cones_map f \<pi> = ?\<chi>"
show "\<forall>j. J.arr j \<longrightarrow> \<pi> j \<cdot> f = F j"
proof -
have "\<And>j. J.arr j \<Longrightarrow> \<pi> j \<cdot> f = F j"
proof -
fix j
assume j: "J.arr j"
have "\<pi> j \<cdot> f = D.cones_map f \<pi> j"
using j f cone_axioms by force
also have "... = F j" using j 1 by simp
finally show "\<pi> j \<cdot> f = F j" by auto
qed
thus ?thesis by auto
qed
next
assume 1: "\<forall>j. J.arr j \<longrightarrow> \<pi> j \<cdot> f = F j"
show "D.cones_map f \<pi> = ?\<chi>"
using 1 f is_cone \<chi>.extensionality D.is_discrete is_cone cone_\<chi> by auto
qed
qed
ultimately show ?thesis by blast
qed
abbreviation induced_arrow' :: "'c \<Rightarrow> ('j \<Rightarrow> 'c) \<Rightarrow> 'c"
where "induced_arrow' b F \<equiv> induced_arrow b (D.mkCone F)"
lemma induced_arrowI':
assumes "C.ide b"and"\<And>j. J.arr j \<Longrightarrow> \<guillemotleft>F j : b \<rightarrow> D j\<guillemotright>"
shows "\<And>j. J.arr j \<Longrightarrow> \<pi> j \<cdot> induced_arrow' b F = F j"
proof -
interpret B: constant_functor J C b
using assms(1) by unfold_locales auto
interpret \<chi>: cone J C D b \<open>D.mkCone F\<close>
using assms D.cone_mkCone by blast
have cone_\<chi>: "D.cone b (D.mkCone F)" ..
hence 1: "D.cones_map (induced_arrow' b F) \<pi> = D.mkCone F"
using induced_arrowI by blast
fix j
assume j: "J.arr j"
have "\<pi> j \<cdot> induced_arrow' b F = D.cones_map (induced_arrow' b F) \<pi> j"
using induced_arrowI(1) cone_\<chi> is_cone extensionality by force
also have "... = F j"
using j 1 by auto
finally show "\<pi> j \<cdot> induced_arrow' b F = F j"
by auto
qed
end
context discrete_diagram begin
lemma product_coneI:
assumes "limit_cone a \<pi>"
shows "product_cone J C D a \<pi>"
by (meson assms discrete_diagram_axioms functor_axioms functor_def product_cone.intro)
end
context category begin
definition has_as_product
where "has_as_product J D a \<equiv> (\<exists>\<pi>. product_cone J C D a \<pi>)"
abbreviation has_product
where "has_product J D \<equiv> \<exists>a. has_as_product J D a"
lemma product_is_ide:
assumes "has_as_product J D a"
shows "ide a"
proof -
obtain \<pi> where \<pi>: "product_cone J C D a \<pi>"
using assms has_as_product_def by blast
interpret \<pi>: product_cone J C D a \<pi>
using \<pi> by auto
show ?thesis using \<pi>.ide_apex by auto
qed
text\<open>
A category has @{term I}-indexed products for an @{typ 'i}-set @{term I} if every @{term I}-indexed discrete diagram has a product. In order to reap the benefits of being able to directly identify the elements of a set I with the objects of discrete category it generates (thereby avoiding
the use of coercion maps), it is necessary to assume that @{term "I \<noteq> UNIV"}. If we want to assert that a category has products indexed by the universe of
some type @{typ 'i}, we have to pass to a larger type, such as @{typ "'i option"}.
\<close>
definition has_products
where "has_products (I :: 'i set) \<equiv>
I \<noteq> UNIV \<and>
(\<forall>J D. discrete_diagram J C D \<and> Collect (partial_composition.arr J) = I
\<longrightarrow> (\<exists>a. has_as_product J D a))"
lemma has_productE:
assumes "\<exists>a. has_product J D"
obtains a \<pi> where "product_cone J C D a \<pi>"
using assms has_as_product_def by metis
lemma has_products_if_has_limits:
assumes "has_limits (undefined :: 'j)"and"I \<noteq> (UNIV :: 'j set)"
shows "has_products I"
proof (unfold has_products_def, intro conjI allI impI)
show "I \<noteq> UNIV" by fact
fix J D
assume D: "discrete_diagram J C D \<and> Collect (partial_composition.arr J) = I"
interpret D: discrete_diagram J C D
using D by simp
have 1: "\<exists>a. D.has_as_limit a"
using assms D D.diagram_axioms D.J.category_axioms
by (simp add: has_limits_of_shape_def has_limits_def)
show "\<exists>a. has_as_product J D a"
using 1 has_as_product_def D.product_coneI by blast
qed
lemma has_finite_products_if_has_finite_limits:
assumes "\<And>J :: 'j comp. (finite (Collect (partial_composition.arr J))) \<Longrightarrow> has_limits_of_shape J" and"finite (I :: 'j set)"and"I \<noteq> UNIV"
shows "has_products I"
proof (unfold has_products_def, intro conjI allI impI)
show "I \<noteq> UNIV" by fact
fix J D
assume D: "discrete_diagram J C D \<and> Collect (partial_composition.arr J) = I"
interpret D: discrete_diagram J C D
using D by simp
have 1: "\<exists>a. D.has_as_limit a"
using assms D has_limits_of_shape_def D.diagram_axioms by auto
show "\<exists>a. has_as_product J D a"
using 1 has_as_product_def D.product_coneI by blast
qed
lemma has_products_preserved_by_bijection:
assumes "has_products I"and"bij_betw \<phi> I I'"and"I' \<noteq> UNIV"
shows "has_products I'"
proof (unfold has_products_def, intro conjI allI impI)
show "I' \<noteq> UNIV" by fact
show "\<And>J' D'. discrete_diagram J' C D' \<and> Collect (partial_composition.arr J') = I'
\<Longrightarrow> \<exists>a. has_as_product J' D' a"
proof -
fix J' D'
assume 1: "discrete_diagram J' C D' \<and> Collect (partial_composition.arr J') = I'"
interpret J': category J'
using 1 by (simp add: discrete_diagram_def)
interpret D': discrete_diagram J' C D'
using 1 by simp
interpret J: discrete_category I \<open>SOME x. x \<notin> I\<close>
using assms has_products_def [of I] someI_ex [of"\<lambda>x. x \<notin> I"]
by unfold_locales auto
have 2: "Collect J.arr = I \<and> Collect J'.arr = I'"
using 1 by auto
have \<phi>: "bij_betw \<phi> (Collect J.arr) (Collect J'.arr)"
using 2 assms(2) by simp let ?\<phi> = "\<lambda>j. if J.arr j then \<phi> j else J'.null" let ?\<phi>' = "\<lambda>j'. if J'.arr j'then the_inv_into I \<phi> j' else J.null"
interpret \<phi>: "functor" J.comp J' ?\<phi>
proof -
have "\<phi> ` I = I'"
using \<phi> 2 bij_betw_def [of \<phi> I I'] by simp
hence "\<And>j. J.arr j \<Longrightarrow> J'.arr (?\<phi> j)"
using 1 D'.is_discrete by auto
thus "functor J.comp J' ?\<phi>"
using D'.is_discrete J.is_discrete J.seqE
by unfold_locales auto
qed
interpret \<phi>': "functor" J' J.comp ?\<phi>'
proof -
have "the_inv_into I \<phi> ` I' = I"
using assms(2) \<phi> bij_betw_the_inv_into bij_betw_imp_surj_on by metis
hence "\<And>j'. J'.arr j' \<Longrightarrow> J.arr (?\<phi>' j')"
using 2 D'.is_discrete J.is_discrete by auto
thus "functor J' J.comp ?\<phi>'"
using D'.is_discrete J.is_discrete J'.seqE
by unfold_locales auto
qed let ?D = "\<lambda>i. D' (\<phi> i)"
interpret D: discrete_diagram_from_map I C ?D \<open>SOME j. j \<notin> I\<close>
using assms 1 D'.is_discrete bij_betw_imp_surj_on \<phi>.preserves_ide
by unfold_locales auto
obtain a where a: "has_as_product J.comp D.map a"
using assms D.discrete_diagram_axioms has_products_def [of I] by auto
obtain \<pi> where \<pi>: "product_cone J.comp C D.map a \<pi>"
using a has_as_product_def by blast
interpret \<pi>: product_cone J.comp C D.map a \<pi>
using \<pi> by simp let ?\<pi>' = "\<pi> o ?\<phi>'"
interpret A: constant_functor J' C a
using \<pi>.ide_apex by unfold_locales simp
interpret \<pi>': natural_transformation J' C A.map D' ?\<pi>'
proof -
have "\<pi>.A.map \<circ> ?\<phi>' = A.map"
using \<phi> A.map_def \<phi>'.preserves_arr \<pi>.A.extensionality J.not_arr_null by auto
moreover have "D.map \<circ> ?\<phi>' = D'"
proof
fix j'
have "J'.arr j' \<Longrightarrow> (D.map \<circ> ?\<phi>') j' = D' j'"
proof -
assume 2: "J'.arr j'"
have 3: "inj_on \<phi> I"
using assms(2) bij_betw_imp_inj_on by auto
have "\<phi> ` I = I'"
by (metis (no_types) assms(2) bij_betw_imp_surj_on)
hence "\<phi> ` I = Collect J'.arr"
using 1 by force
thus ?thesis
using 23 D.map_def \<phi>'.preserves_arr f_the_inv_into_f by fastforce
qed
moreover have "\<not> J'.arr j' \<Longrightarrow> (D.map \<circ> ?\<phi>') j' = D' j'"
using D.extensionality D'.extensionality
by (simp add: J.Null_not_in_Obj J.null_char)
ultimately show "(D.map \<circ> ?\<phi>') j' = D' j'" by blast
qed
ultimately show "natural_transformation J' C A.map D' ?\<pi>'"
using \<pi>.natural_transformation_axioms \<phi>'.as_nat_trans.natural_transformation_axioms
horizontal_composite [of J' J.comp ?\<phi>' ?\<phi>' ?\<phi>' C \<pi>.A.map D.map \<pi>]
by simp
qed
interpret \<pi>': cone J' C D' a ?\<pi>' ..
interpret \<pi>': product_cone J' C D' a ?\<pi>'
proof
fix a' \<chi>'
assume \<chi>': "D'.cone a' \<chi>'"
interpret \<chi>': cone J' C D' a' \<chi>'
using \<chi>' by simp
show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D'.cones_map f (\<pi> \<circ> ?\<phi>') = \<chi>'"
proof - let ?\<chi> = "\<chi>' o ?\<phi>"
interpret A': constant_functor J.comp C a'
using \<chi>'.ide_apex by unfold_locales simp
interpret \<chi>: natural_transformation J.comp C A'.map D.map ?\<chi>
proof -
have "\<chi>'.A.map \<circ> ?\<phi> = A'.map"
using \<phi> \<phi>.preserves_arr A'.map_def \<chi>'.A.extensionality by auto
moreover have "D' \<circ> ?\<phi> = D.map"
using \<phi> D.map_def D'.extensionality by auto
ultimately show "natural_transformation J.comp C A'.map D.map ?\<chi>"
using \<chi>'.natural_transformation_axioms
\<phi>.as_nat_trans.natural_transformation_axioms
horizontal_composite [of J.comp J' ?\<phi> ?\<phi> ?\<phi> C \<chi>'.A.map D' \<chi>']
by simp
qed
interpret \<chi>: cone J.comp C D.map a' ?\<chi> ..
have *: "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D.cones_map f \<pi> = ?\<chi>"
using \<pi>.is_universal \<chi>.cone_axioms by simp
show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D'.cones_map f ?\<pi>' = \<chi>'"
proof -
have "\<exists>f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D'.cones_map f ?\<pi>' = \<chi>'"
proof -
obtain f where f: "\<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D.cones_map f \<pi> = ?\<chi>"
using * by blast
have "D'.cones_map f ?\<pi>' = \<chi>'"
proof
fix j'
show "D'.cones_map f ?\<pi>' j' = \<chi>' j'"
proof (cases "J'.arr j'")
assume j': "\<not> J'.arr j'"
show "D'.cones_map f ?\<pi>' j' = \<chi>' j'"
using f j' \<chi>'.extensionality \<pi>'.cone_axioms by auto
next
assume j': "J'.arr j'"
show "D'.cones_map f ?\<pi>' j' = \<chi>' j'"
proof -
have "D'.cones_map f ?\<pi>' j' = \<pi> (the_inv_into I \<phi> j') \<cdot> f"
using f j' \<pi>'.cone_axioms by auto
also have "... = D.cones_map f \<pi> (the_inv_into I \<phi> j')"
proof -
have "arr f \<and> dom f = a' \<and> cod f = a"
using f by blast
thus ?thesis
using \<phi>'.preserves_arr \<pi>.is_cone j' by auto
qed
also have "... = (\<chi>' \<circ> ?\<phi>) (the_inv_into I \<phi> j')"
using f by simp
also have "... = \<chi>' j'"
using assms(2) j' 2 bij_betw_def [of \<phi> I I'] bij_betw_imp_inj_on
\<phi>'.preserves_arr f_the_inv_into_f
by fastforce
finally show ?thesis by simp
qed
qed
qed
thus ?thesis using f by blast
qed
moreover have "\<And>f f'. \<lbrakk> \<guillemotleft>f : a' \<rightarrow> a\<guillemotright>; D'.cones_map f ?\<pi>' = \<chi>';
\<guillemotleft>f' : a' \<rightarrow> a\<guillemotright>; D'.cones_map f' ?\<pi>' = \<chi>' \<rbrakk>
\<Longrightarrow> f = f'"
proof -
fix f f'
assume f: "\<guillemotleft>f : a' \<rightarrow> a\<guillemotright>"and f': "\<guillemotleft>f' : a' \<rightarrow> a\<guillemotright>" and f\<chi>': "D'.cones_map f ?\<pi>' = \<chi>'" and f'\<chi>': "D'.cones_map f' ?\<pi>' = \<chi>'"
have "D.cones_map f \<pi> = \<chi>' \<circ> ?\<phi> \<and> D.cones_map f' \<pi> = \<chi>' o ?\<phi>"
proof (intro conjI)
show "D.cones_map f \<pi> = \<chi>' \<circ> ?\<phi>"
proof
fix j
have "\<not> J.arr j \<Longrightarrow> D.cones_map f \<pi> j = (\<chi>' \<circ> ?\<phi>) j"
using f f\<chi>' \<pi>.cone_axioms \<chi>.extensionality by auto
moreover have "J.arr j \<Longrightarrow> D.cones_map f \<pi> j = (\<chi>' \<circ> ?\<phi>) j"
proof -
assume j: "J.arr j"
have 1: "j = the_inv_into I \<phi> (\<phi> j)"
using assms(2) j \<phi> the_inv_into_f_f bij_betw_imp_inj_on J.arr_char
by metis
have "D.cones_map f \<pi> j = D.cones_map f \<pi> (the_inv_into I \<phi> (\<phi> j))"
using 1 by simp
also have "... = (\<chi>' \<circ> ?\<phi>) j"
using f j f\<chi>' 1 \<pi>.cone_axioms \<pi>'.cone_axioms \<phi>.preserves_arr by auto
finally show "D.cones_map f \<pi> j = (\<chi>' \<circ> ?\<phi>) j" by blast
qed
ultimately show "D.cones_map f \<pi> j = (\<chi>' \<circ> ?\<phi>) j" by blast
qed
show "D.cones_map f' \<pi> = \<chi>' \<circ> ?\<phi>"
proof
fix j
have "\<not> J.arr j \<Longrightarrow> D.cones_map f' \<pi> j = (\<chi>' \<circ> ?\<phi>) j"
using f' f\<chi>' \<pi>.cone_axioms \<chi>.extensionality by auto
moreover have "J.arr j \<Longrightarrow> D.cones_map f' \<pi> j = (\<chi>' \<circ> ?\<phi>) j"
proof -
assume j: "J.arr j"
have 1: "j = the_inv_into I \<phi> (\<phi> j)"
using assms(2) j \<phi> the_inv_into_f_f bij_betw_imp_inj_on J.arr_char
by metis
have "D.cones_map f' \<pi> j = D.cones_map f' \<pi> (the_inv_into I \<phi> (\<phi> j))"
using 1 by simp
also have "... = (\<chi>' \<circ> ?\<phi>) j"
using f' j f'\<chi>' 1 \<pi>.cone_axioms \<pi>'.cone_axioms \<phi>.preserves_arr by auto
finally show "D.cones_map f' \<pi> j = (\<chi>' \<circ> ?\<phi>) j" by blast
qed
ultimately show "D.cones_map f' \<pi> j = (\<chi>' \<circ> ?\<phi>) j" by blast
qed
qed
thus "f = f'"
using f f' * by auto
qed
ultimately show ?thesis by blast
qed
qed
qed
have "has_as_product J' D' a"
using has_as_product_def \<pi>'.product_cone_axioms by auto
thus "\<exists>a. has_as_product J' D' a" by blast
qed
qed
lemma ide_is_unary_product:
assumes "ide a"
shows "\<And>m n :: nat. m \<noteq> n \<Longrightarrow> has_as_product (discrete_category.comp {m :: nat} (n :: nat))
(\<lambda>i. if i = m then a else null) a"
proof -
fix m n :: nat
assume neq: "m \<noteq> n"
have "{m :: nat} \<noteq> UNIV"
proof -
have "finite {m :: nat}" by simp
moreover have "\<not>finite (UNIV :: nat set)" by simp
ultimately show ?thesis by fastforce
qed
interpret J: discrete_category "{m :: nat}" \<open>n :: nat\<close>
using neq \<open>{m :: nat} \<noteq> UNIV\<close> by unfold_locales auto let ?D = "\<lambda>i. if i = m then a else null"
interpret D: discrete_diagram J.comp C ?D
apply unfold_locales
using assms J.null_char neq
apply auto
by metis
interpret A: constant_functor J.comp C a
using assms by unfold_locales auto
show "has_as_product J.comp ?D a"
proof (unfold has_as_product_def) let ?\<pi> = "\<lambda>i :: nat. if i = m then a else null"
interpret \<pi>: natural_transformation J.comp C A.map ?D ?\<pi>
using assms J.arr_char J.dom_char J.cod_char
by unfold_locales auto
interpret \<pi>: cone J.comp C ?D a ?\<pi> ..
interpret \<pi>: product_cone J.comp C ?D a ?\<pi>
proof
fix a' \<chi>'
assume \<chi>': "D.cone a' \<chi>'"
interpret \<chi>': cone J.comp C ?D a' \<chi>' using \<chi>' by auto
show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> D.cones_map f ?\<pi> = \<chi>'"
proof
show "\<guillemotleft>\<chi>' m : a' \<rightarrow> a\<guillemotright> \<and> D.cones_map (\<chi>' m) ?\<pi> = \<chi>'"
proof
show 1: "\<guillemotleft>\<chi>' m : a' \<rightarrow> a\<guillemotright>"
using \<chi>'.preserves_hom \<chi>'.A.map_def J.arr_char J.dom_char J.cod_char
by auto
show "D.cones_map (\<chi>' m) ?\<pi> = \<chi>'"
proof
fix j "D.cones_map (\<chi>' ) (\<lambdai. if i = m thenaelsenull) j \<hi>' "
using J.arr_char J.dom_char J.cod_char J.ide_char \<pi>.cone_axioms comp_cod_arr
(asesj =m"
using>.extensionality java.lang.StringIndexOutOfBoundsException: Index 54 out of bounds for length 54
qed
qed val=.invent_names_globalf0"java.lang.StringIndexOutOfBoundsException: Index 57 out of bounds for length 57
proof -
show =<chi mjava.lang.StringIndexOutOfBoundsException: Index 34 out of bounds for length 34
using \chi'preserves_homJarr_charJdom_charJ.cod_char\pi.cone_axioms
comp_cod_arr foldKmk_allargs' Logicmk_implies (,concl)end
java.lang.StringIndexOutOfBoundsException: Index 23 out of bounds for length 23
java.lang.StringIndexOutOfBoundsException: Index 15 out of bounds for length 15
qed
qed
show<<>product_coneJcomp <>.if=m then nulla\pi>
qed
qed
lemma has_unary_products:
assumes "card I = 1"and"I \<noteq> UNIV"
shows "has_products I"
proof -
obtain i where i: "I = {i}"
using assms card_1_singletonE by blast
obtain n where n: "n \<notin> I"
using assms by auto
have "has_products {1 :: nat}"
proof (unfold has_products_def, intro conjI)
show "{1 :: nat} \<noteq> UNIV" by auto
show "\<forall>(J :: nat comp) D.
discrete_diagram J (\<cdot>) D \<and> Collect (partial_composition.arr J) = {1}
\<longrightarrow> (\<exists>a. has_as_product J D a)"
proof
fix J :: "nat comp"
show "\<forall>D. discrete_diagram J (\<cdot>) D \<and> Collect (partial_composition.arr J) = {1}
\<longrightarrow> (\<exists>a. has_as_product J D a)"
proof (intro allI impI)
fix D
assume D: "discrete_diagram J (\<cdot>) D \<and> Collect (partial_composition.arr J) = {1}"
interpret D: discrete_diagram J C D
using D by auto
interpret J: discrete_category \<open>{1 :: nat}\<close> D.J.null
by (metis D D.J.not_arr_null discrete_category.intro mem_Collect_eq)
have 1: "has_as_product J.comp D (D 1)"
proof -
have "has_as_product J.comp (\<lambda>i. if i = 1 then D 1 else null) (D 1)"
using ide_is_unary_product D.preserves_ide D.is_discrete D J.null_char
by (metis J.Null_not_in_Obj insertCI mem_Collect_eq)
moreover have "D = (\<lambda>i. if i = 1 then D 1 else null)"
proof
fix j
show "D j = (if j = 1 then D 1 else null)"
using D D.extensionality by auto
qed
ultimately show ?thesis by simp
qed
moreover have "J = J.comp"
proof -
have "\<And>j j'. J j j' = J.comp j j'"
proof -
fix j j'
show "J j j' = J.comp j j'"
using J.comp_char D.is_discrete D
by (metis D.J.category_axioms D.J.ext D.J.ide_def J.null_char
category.seqE mem_Collect_eq)
qed
thus ?thesis by auto
qed
ultimately show "\<exists>a. has_as_product J D a" by auto
qed
qed
qed
moreover have "bij_betw (\<lambda>k. if k = 1 then i else n) {1 :: nat} I"
using i by (intro bij_betwI') auto
ultimately show "has_products I"
using assms has_products_preserved_by_bijection by blast
qed
end
subsection "Equalizers"
text\<open>
An \emph{equalizer} in a category @{term C} is a limit of a parallel pair of arrows in @{term C}.
\<close>
locale parallel_pair_diagram =
J: parallel_pair +
C: category C
for C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and f0 :: 'c and f1 :: 'c +
assumes is_parallel: "C.par f0 f1" begin
definition map
where "map \<equiv> (\<lambda>j. if j = J.Zero then C.dom f0 elseif j = J.One then C.cod f0 elseif j = J.j0 then f0 elseif j = J.j1 then f1 else C.null)"
lemma map_simp:
shows "map J.Zero = C.dom f0" and"map J.One = C.cod f0" and"map J.j0 = f0" and"map J.j1 = f1"
proof -
show "map J.Zero = C.dom f0"
using map_def by metis
show "map J.One = C.cod f0"
using map_def J.Zero_not_eq_One by metis
show "map J.j0 = f0"
using map_def J.Zero_not_eq_j0 J.One_not_eq_j0 by metis
show "map J.j1 = f1"
using map_def J.Zero_not_eq_j1 J.One_not_eq_j1 J.j0_not_eq_j1 by metis
qed
end
sublocale parallel_pair_diagram \<subseteq> diagram J.comp C map
apply unfold_locales
apply (simp add: J.arr_char map_def)
using map_def is_parallel J.arr_char J.cod_simp J.dom_simp
apply auto[2]
proof -
show 1: "\<And>j. J.arr j \<Longrightarrow> C.cod (map j) = map (J.cod j)"
using is_parallel map_simp(1-4) J.arr_char by auto
next
fix j j'
assume jj': "J.seq j' j"
show "map (j' \<cdot>\<^sub>J j) = map j' \<cdot> map j"
proof -
have 1: "(j = J.Zero \<and> j' \<noteq> J.One) \<or> (j \<noteq> J.Zero \<and> j' = J.One)"
using jj' J.seq_char by blast
moreover have "j = J.Zero \<and> j' \<noteq> J.One \<Longrightarrow> ?thesis"
by (metis (no_types, lifting) C.arr_dom_iff_arr C.comp_arr_dom C.dom_dom
J.comp_simp(1) jj' map_simp(1,3-4) J.arr_char is_parallel)
moreover have "j \<noteq> J.Zero \<and> j' = J.One \<Longrightarrow> ?thesis"
by (metis (no_types, lifting) C.comp_arr_dom C.comp_cod_arr C.seqE J.comp_char jj'
map_simp(2-4) J.arr_char is_parallel)
ultimately show ?thesis by blast
qed
qed
context parallel_pair_diagram begin
definition mkCone
where "mkCone e \<equiv> \<lambda>j. if J.arr j then if j = J.Zero then e else f0 \<cdot> e else C.null"
abbreviation is_equalized_by
where "is_equalized_by e \<equiv> C.seq f0 e \<and> f0 \<cdot> e = f1 \<cdot> e"
abbreviation has_as_equalizer
where "has_as_equalizer e \<equiv> limit_cone (C.dom e) (mkCone e)"
lemma cone_mkCone:
assumes "is_equalized_by e"
shows "cone (C.dom e) (mkCone e)"
proof -
interpret E: constant_functor J.comp C \<open>C.dom e\<close>
using assms by unfold_locales auto
show "cone (C.dom e) (mkCone e)"
proof (unfold_locales)
show "\<And>j. \<not> J.arr j \<Longrightarrow> mkCone e j = C.null"
using assms mkCone_def by auto
show "\<And>j. J.arr j \<Longrightarrow> C.arr (mkCone e j)"
using assms mkCone_def by auto
show "\<And>j. J.arr j \<Longrightarrow> map j \<cdot> mkCone e (J.dom j) = mkCone e j"
using assms mkCone_def C.comp_cod_arr extensionality map_def is_parallel
apply auto
using parallel_pair.arr_char by auto
show "\<And>j. J.arr j \<Longrightarrow> mkCone e (J.cod j) \<cdot> E.map j = mkCone e j"
using assms mkCone_def C.comp_arr_dom
apply auto[1]
by (metis (lifting) J.comp_cod_arr J.seq_char J.Zero_not_eq_One)
qed
qed
lemma is_equalized_by_cone:
assumes "cone a \<chi>"
shows "is_equalized_by (\<chi> (J.Zero))"
proof -
interpret \<chi>: cone J.comp C map a \<chi>
using assms by auto
show ?thesis
by (metis \<chi>.cod_determines_component \<chi>.naturality1 \<chi>.preserves_cod
C.arr_cod_iff_arr is_parallel map_simp(2-4) J.cod_simp(3,4)
J.dom_simp(3-4) preserves_reflects_arr)
qed
lemma mkCone_cone:
assumes "cone a \<chi>"
shows "mkCone (\<chi> J.Zero) = \<chi>"
proof -
interpret \<chi>: cone J.comp C map a \<chi>
using assms by auto
have 1: "is_equalized_by (\<chi> J.Zero)"
using assms is_equalized_by_cone by blast
show ?thesis
proof
fix j
have "j = J.Zero \<Longrightarrow> mkCone (\<chi> J.Zero) j = \<chi> j"
using mkCone_def \<chi>.extensionality by simp
moreover have "j = J.One \<or> j = J.j0 \<or> j = J.j1 \<Longrightarrow> mkCone (\<chi> J.Zero) j = \<chi> j"
using J.arr_char J.cod_char J.dom_char J.seq_char mkCone_def
\<chi>.naturality1 \<chi>.naturality2 \<chi>.A.map_simp map_def
by (metis (no_types, lifting) J.Zero_not_eq_j0 J.dom_simp(2))
ultimately have "J.arr j \<Longrightarrow> mkCone (\<chi> J.Zero) j = \<chi> j"
using J.arr_char by auto
thus "mkCone (\<chi> J.Zero) j = \<chi> j"
using mkCone_def \<chi>.extensionality by fastforce
qed
qed
end
locale equalizer_cone =
J: parallel_pair +
C: category C +
D: parallel_pair_diagram C f0 f1 +
limit_cone J.comp C D.map"C.dom e""D.mkCone e"
for C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) and f0 :: 'c and f1 :: 'c and e :: 'c begin
lemma equalizes:
shows "D.is_equalized_by e"
proof
show "C.seq f0 e"
proof (intro C.seqI)
show "C.arr e" using ide_apex C.arr_dom_iff_arr by fastforce
show "C.arr f0"
using D.map_simp D.preserves_arr J.arr_char by metis
show "C.dom f0 = C.cod e"
using J.arr_char J.ide_char D.mkCone_def D.map_simp preserves_cod [of J.Zero]
by auto
qed
show "f0 \<cdot> e = f1 \<cdot> e"
using D.map_simp D.mkCone_def J.arr_char naturality [of J.j0] naturality [of J.j1]
by force
qed
lemma is_universal':
assumes "D.is_equalized_by e'"
shows "\<exists>!h. \<guillemotleft>h : C.dom e' \<rightarrow> C.dom e\<guillemotright> \<and> e \<cdot> h = e'"
proof -
have "D.cone (C.dom e') (D.mkCone e')"
using assms D.cone_mkCone by blast
moreover have 0: "D.cone (C.dom e) (D.mkCone e)" ..
ultimately have 1: "\<exists>!h. \<guillemotleft>h : C.dom e' \<rightarrow> C.dom e\<guillemotright> \<and>
D.cones_map h (D.mkCone e) = D.mkCone e'"
using is_universal [of"C.dom e'""D.mkCone e'"] by auto
have 2: "\<And>h. \<guillemotleft>h : C.dom e' \<rightarrow> C.dom e\<guillemotright> \<Longrightarrow>
D.cones_map h (D.mkCone e) = D.mkCone e' \<longleftrightarrow> e \<cdot> h = e'"
proof -
fix h
assume h: "\<guillemotleft>h : C.dom e' \<rightarrow> C.dom e\<guillemotright>"
show "D.cones_map h (D.mkCone e) = D.mkCone e' \<longleftrightarrow> e \<cdot> h = e'"
proof
assume 3: "D.cones_map h (D.mkCone e) = D.mkCone e'"
show "e \<cdot> h = e'"
proof -
have "e' = D.mkCone e' J.Zero"
using D.mkCone_def J.arr_char by simp
also have "... = D.cones_map h (D.mkCone e) J.Zero"
using 3 by simp
also have "... = e \<cdot> h"
using 0 h D.mkCone_def J.arr_char by auto
finally show ?thesis by auto
qed
next
assume e': "e \<cdot> h = e'"
show "D.cones_map h (D.mkCone e) = D.mkCone e'"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> D.cones_map h (D.mkCone e) j = D.mkCone e' j"
using h cone_axioms D.mkCone_def by auto
moreover have "j = J.Zero \<Longrightarrow> D.cones_map h (D.mkCone e) j = D.mkCone e' j"
using h e' is_cone D.mkCone_def J.arr_char [of J.Zero] by force
moreover have "J.arr j \<and> j \<noteq> J.Zero \<Longrightarrow> D.cones_map h (D.mkCone e) j = D.mkCone e' j"
using C.comp_assoc D.mkCone_def is_cone e' h by auto
ultimately show "D.cones_map h (D.mkCone e) j = D.mkCone e' j" by blast
qed
qed
qed
thus ?thesis using 1 by blast
qed
lemma induced_arrowI':
assumes "D.is_equalized_by e'"
shows "\<guillemotleft>induced_arrow (C.dom e') (D.mkCone e') : C.dom e' \<rightarrow> C.dom e\<guillemotright>" and"e \<cdot> induced_arrow (C.dom e') (D.mkCone e') = e'"
proof -
interpret A': constant_functor J.comp C \<open>C.dom e'\<close>
using assms by (unfold_locales, auto)
have cone: "D.cone (C.dom e') (D.mkCone e')"
using assms D.cone_mkCone [of e'] by blast
have "e \<cdot> induced_arrow (C.dom e') (D.mkCone e') =
D.cones_map (induced_arrow (C.dom e') (D.mkCone e')) (D.mkCone e) J.Zero"
using cone induced_arrowI(1) D.mkCone_def J.arr_char is_cone by force
also have "... = e'"
proof -
have "D.cones_map (induced_arrow (C.dom e') (D.mkCone e')) (D.mkCone e) =
D.mkCone e'"
using cone induced_arrowI by blast
thus ?thesis
using J.arr_char D.mkCone_def by simp
qed
finally have 1: "e \<cdot> induced_arrow (C.dom e') (D.mkCone e') = e'"
by auto
show "\<guillemotleft>induced_arrow (C.dom e') (D.mkCone e') : C.dom e' \<rightarrow> C.dom e\<guillemotright>"
using 1 cone induced_arrowI by simp
show "e \<cdot> induced_arrow (C.dom e') (D.mkCone e') = e'"
using 1 cone induced_arrowI by simp
qed
end
context category begin
definition has_as_equalizer
where "has_as_equalizer f0 f1 e \<equiv> par f0 f1 \<and> parallel_pair_diagram.has_as_equalizer C f0 f1 e"
definition has_equalizers
where "has_equalizers = (\<forall>f0 f1. par f0 f1 \<longrightarrow> (\<exists>e. has_as_equalizer f0 f1 e))"
lemma has_as_equalizerI [intro]:
assumes "par f g"and"seq f e"and"f \<cdot> e = g \<cdot> e" and"\<And>e'. \<lbrakk>seq f e'; f \<cdot> e' = g \<cdot> e'\<rbrakk> \<Longrightarrow> \<exists>!h. e \<cdot> h = e'"
shows "has_as_equalizer f g e"
proof (unfold has_as_equalizer_def, intro conjI)
show "arr f"and"arr g"and"dom f = dom g"and"cod f = cod g"
using assms(1) by auto
interpret J: parallel_pair .
interpret D: parallel_pair_diagram C f g
using assms(1) by unfold_locales
show "D.has_as_equalizer e"
proof - let ?\<chi> = "D.mkCone e" let ?a = "dom e"
interpret \<chi>: cone J.comp C D.map ?a ?\<chi>
using assms(2-3) D.cone_mkCone [of e] by simp
interpret \<chi>: limit_cone J.comp C D.map ?a ?\<chi>
proof
fix a' \<chi>'
assume \<chi>': "D.cone a' \<chi>'"
interpret \<chi>': cone J.comp C D.map a' \<chi>'
using \<chi>' by blast
have 0: "seq f (\<chi>' J.Zero)"
using J.ide_char J.arr_char \<chi>'.preserves_hom
by (meson D.is_equalized_by_cone \<chi>')
have 1: "\<exists>!h. e \<cdot> h = \<chi>' J.Zero"
using assms 0 \<chi>' D.is_equalized_by_cone by blast
obtain h where h: "e \<cdot> h = \<chi>' J.Zero"
using 1 by blast
have 2: "D.is_equalized_by e"
using assms(2-3) by blast
have "\<exists>h. \<guillemotleft>h : a' \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h (D.mkCone e) = \<chi>'"
proof
show "\<guillemotleft>h : a' \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h (D.mkCone e) = \<chi>'"
proof
show 3: "\<guillemotleft>h : a' \<rightarrow> dom e\<guillemotright>"
using h \<chi>'.preserves_dom
by (metis (no_types, lifting) \<chi>'.component_in_hom \<open>seq f (\<chi>' J.Zero)\<close>
category.has_codomain_iff_arr category.seqE category_axioms cod_in_codomains
domains_comp in_hom_def parallel_pair.arr_char)
show "D.cones_map h (D.mkCone e) = \<chi>'"
proof
fix j
have "D.cone (cod h) (D.mkCone e)"
using 23 D.cone_mkCone by auto
thus "D.cones_map h (D.mkCone e) j = \<chi>' j"
using h 23 D.cone_mkCone [of e] J.arr_char D.mkCone_def comp_assoc
apply (cases "J.arr j")
apply simp_all
apply (metis (no_types, lifting) D.mkCone_cone \<chi>')
using \<chi>'.extensionality
by presburger
qed
qed
qed
moreover have "\<And>h'. \<guillemotleft>h' : a' \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h' (D.mkCone e) = \<chi>' \<Longrightarrow> h' = h"
proof (elim conjE)
fix h'
assume h': "\<guillemotleft>h' : a' \<rightarrow> dom e\<guillemotright>"
assume eq: "D.cones_map h' (D.mkCone e) = \<chi>'"
have "e \<cdot> h' = \<chi>' J.Zero"
using eq D.cone_mkCone D.mkCone_def \<chi>'.preserves_reflects_arr \<chi>.cone_axioms 0 eq h' in_homE mem_Collect_eq restrict_apply seqE
apply simp
by fastforce
moreover have "\<exists>!h. e \<cdot> h = \<chi>' J.Zero"
using assms(2,4) 1 category.seqI by blast
ultimately show "h' = h"
using h by auto
qed
ultimately show "\<exists>!h. \<guillemotleft>h : a' \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h (D.mkCone e) = \<chi>'"
by blast
qed
show "D.has_as_equalizer e"
using assms \<chi>.limit_cone_axioms by blast
qed
qed
lemma has_as_equalizerE [elim]:
assumes "has_as_equalizer f g e" and"\<lbrakk>seq f e; f \<cdot> e = g \<cdot> e; \<And>e'. \<lbrakk>seq f e'; f \<cdot> e' = g \<cdot> e'\<rbrakk> \<Longrightarrow> \<exists>!h. e \<cdot> h = e'\<rbrakk> \<Longrightarrow> T"
shows T
proof -
interpret D: parallel_pair_diagram C f g
using assms
by (simp add: category_axioms has_as_equalizer_def parallel_pair_diagram.intro
parallel_pair_diagram_axioms_def)
have "D.has_as_equalizer e"
using assms has_as_equalizer_def by blast
interpret equalizer_cone C f g e
by (simp add: \<open>D.has_as_equalizer e\<close> category_axioms equalizer_cone_def
D.parallel_pair_diagram_axioms)
show T
by (metis arr_iff_in_hom assms(2) dom_comp equalizes is_universal' seqE)
qed
end
section "Limits by Products and Equalizers"
text\<open>
A category with equalizers has limits of shape @{term J} if it has products
indexed by the setof arrows of @{term J} and the setof objects of @{term J}.
The proof is patterned after \<^cite>\<open>"MacLane"\<close>, Theorem 2, page 109:
\begin{quotation}
\noindent
``The limit of \<open>F: J \<rightarrow> C\<close> is the equalizer \<open>e\<close> of \<open>f, g: \<Pi>\<^sub>i F\<^sub>i \<rightarrow> \<Pi>\<^sub>u F\<^sub>c\<^sub>o\<^sub>d \<^sub>u (u \<in> arr J, i \<in> J)\<close>
where \<open>p\<^sub>u f = p\<^sub>c\<^sub>o\<^sub>d \<^sub>u\<close>, \<open>p\<^sub>u g = F\<^sub>u o p\<^sub>d\<^sub>o\<^sub>m \<^sub>u\<close>;
the limiting cone \<open>\<mu>\<close> is \<open>\<mu>\<^sub>j = p\<^sub>j e\<close>, for \<open>j \<in> J\<close>.''
\end{quotation}
\<close>
locale category_with_equalizers =
category C
for C :: "'c comp" (infixr \<open>\<cdot>\<close> 55) +
assumes has_equalizers: "has_equalizers" begin
lemma has_limits_if_has_products:
fixes J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55)
assumes "category J"and"has_products (Collect (partial_composition.ide J))" and"has_products (Collect (partial_composition.arr J))"
shows "has_limits_of_shape J"
proof (unfold has_limits_of_shape_def)
interpret J: category J using assms(1) by auto
have "\<And>D. diagram J C D \<Longrightarrow> (\<exists>a \<chi>. limit_cone J C D a \<chi>)"
proof -
fix D
assume D: "diagram J C D"
interpret D: diagram J C D using D by auto
text\<open>
First, construct the two required products and their cones.
\<close>
interpret Obj: discrete_category \<open>Collect J.ide\<close> J.null
using J.not_arr_null J.ideD(1) mem_Collect_eq by (unfold_locales, blast)
interpret \<Delta>o: discrete_diagram_from_map \<open>Collect J.ide\<close> C D J.null
using D.preserves_ide by (unfold_locales, auto)
have "\<exists>p. has_as_product Obj.comp \<Delta>o.map p"
using assms(2) \<Delta>o.diagram_axioms has_products_def Obj.arr_char
by (metis (no_types, lifting) Collect_cong \<Delta>o.discrete_diagram_axioms mem_Collect_eq)
from this obtain \<Pi>o \<pi>o where \<pi>o: "product_cone Obj.comp C \<Delta>o.map \<Pi>o \<pi>o"
using has_productE [of Obj.comp \<Delta>o.map] by auto
interpret \<pi>o: product_cone Obj.comp C \<Delta>o.map \<Pi>o \<pi>o using \<pi>o by auto
have \<pi>o_in_hom: "\<And>j. Obj.arr j \<Longrightarrow> \<guillemotleft>\<pi>o j : \<Pi>o \<rightarrow> D j\<guillemotright>"
using \<pi>o.preserves_dom \<pi>o.preserves_cod \<Delta>o.map_def by auto
interpret Arr: discrete_category \<open>Collect J.arr\<close> J.null
using J.not_arr_null by (unfold_locales, blast)
interpret \<Delta>a: discrete_diagram_from_map \<open>Collect J.arr\<close> C \<open>D o J.cod\<close> J.null
by (unfold_locales, auto)
have "\<exists>p. has_as_product Arr.comp \<Delta>a.map p"
using assms(3) has_products_def [of"Collect J.arr"] \<Delta>a.discrete_diagram_axioms
by blast
from this obtain \<Pi>a \<pi>a where \<pi>a: "product_cone Arr.comp C \<Delta>a.map \<Pi>a \<pi>a"
using has_productE [of Arr.comp \<Delta>a.map] by auto
interpret \<pi>a: product_cone Arr.comp C \<Delta>a.map \<Pi>a \<pi>a using \<pi>a by auto
have \<pi>a_in_hom: "\<And>j. Arr.arr j \<Longrightarrow> \<guillemotleft>\<pi>a j : \<Pi>a \<rightarrow> D (J.cod j)\<guillemotright>"
using \<pi>a.preserves_cod \<pi>a.preserves_dom \<Delta>a.map_def by auto
text\<open>
Next, construct a parallel pair of arrows \<open>f, g: \<Pi>o \<rightarrow> \<Pi>a\<close>
that expresses the commutativity constraints imposed by the diagram.
\<close>
interpret \<Pi>o: constant_functor Arr.comp C \<Pi>o
using \<pi>o.ide_apex by (unfold_locales, auto) let ?\<chi> = "\<lambda>j. if Arr.arr j then \<pi>o (J.cod j) else null"
interpret \<chi>: cone Arr.comp C \<Delta>a.map \<Pi>o ?\<chi>
using \<pi>o.ide_apex \<pi>o_in_hom \<Delta>a.map_def \<Delta>o.map_def \<Delta>o.is_discrete \<pi>o.naturality2
comp_cod_arr
by (unfold_locales, auto)
let ?f = "\<pi>a.induced_arrow \<Pi>o ?\<chi>"
have f_in_hom: "\<guillemotleft>?f : \<Pi>o \<rightarrow> \<Pi>a\<guillemotright>"
using \<chi>.cone_axioms \<pi>a.induced_arrowI by blast
have f_map: "\<Delta>a.cones_map ?f \<pi>a = ?\<chi>"
using \<chi>.cone_axioms \<pi>a.induced_arrowI by blast
have ff: "\<And>j. J.arr j \<Longrightarrow> \<pi>a j \<cdot> ?f = \<pi>o (J.cod j)"
using \<chi>.component_in_hom \<pi>a.induced_arrowI' \<pi>o.ide_apex by auto
let ?\<chi>' = "\<lambda>j. if Arr.arr j then D j \<cdot> \<pi>o (J.dom j) else null"
interpret \<chi>': cone Arr.comp C \<Delta>a.map \<Pi>o ?\<chi>'
using \<pi>o.ide_apex \<pi>o_in_hom \<Delta>o.map_def \<Delta>a.map_def comp_arr_dom comp_cod_arr
by (unfold_locales, auto) let ?g = "\<pi>a.induced_arrow \<Pi>o ?\<chi>'"
have g_in_hom: "\<guillemotleft>?g : \<Pi>o \<rightarrow> \<Pi>a\<guillemotright>"
using \<chi>'.cone_axioms \<pi>a.induced_arrowI by blast
have g_map: "\<Delta>a.cones_map ?g \<pi>a = ?\<chi>'"
using \<chi>'.cone_axioms \<pi>a.induced_arrowI by blast
have gg: "\<And>j. J.arr j \<Longrightarrow> \<pi>a j \<cdot> ?g = D j \<cdot> \<pi>o (J.dom j)"
using \<chi>'.component_in_hom \<pi>a.induced_arrowI' \<pi>o.ide_apex by force
interpret PP: parallel_pair_diagram C ?f ?g
using f_in_hom g_in_hom
by (elim in_homE, unfold_locales, auto)
from PP.is_parallel obtain e where equ: "PP.has_as_equalizer e"
using has_equalizers has_equalizers_def has_as_equalizer_def by blast
interpret EQU: limit_cone PP.J.comp C PP.map \<open>dom e\<close> \<open>PP.mkCone e\<close>
using equ by auto
interpret EQU: equalizer_cone C ?f ?g e ..
text\<open>
An arrow @{term h} with @{term "cod h = \<Pi>o"} equalizes @{term f} and @{term g} ifand only if it satisfies the commutativity condition required for a cone over
@{term D}.
\<close>
have E: "\<And>h. \<guillemotleft>h : dom h \<rightarrow> \<Pi>o\<guillemotright> \<Longrightarrow>
?f \<cdot> h = ?g \<cdot> h \<longleftrightarrow> (\<forall>j. J.arr j \<longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h)"
proof
fix h
assume h: "\<guillemotleft>h : dom h \<rightarrow> \<Pi>o\<guillemotright>"
show "?f \<cdot> h = ?g \<cdot> h \<Longrightarrow> \<forall>j. J.arr j \<longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h"
proof -
assume E: "?f \<cdot> h = ?g \<cdot> h"
have "\<And>j. J.arr j \<Longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h"
proof -
fix j
assume j: "J.arr j"
have "?\<chi> j \<cdot> h = \<Delta>a.cones_map ?f \<pi>a j \<cdot> h"
using j f_map by fastforce
also have "... = \<pi>a j \<cdot> ?f \<cdot> h"
using j f_in_hom \<Delta>a.map_def \<pi>a.is_cone comp_assoc by auto
also have "... = \<pi>a j \<cdot> ?g \<cdot> h"
using j E by simp
also have "... = \<Delta>a.cones_map ?g \<pi>a j \<cdot> h"
using j g_in_hom \<Delta>a.map_def \<pi>a.is_cone comp_assoc by auto
also have "... = ?\<chi>' j \<cdot> h"
using j g_map by force
finally show "?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h" by auto
qed
thus "\<forall>j. J.arr j \<longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h" by blast
qed
show "\<forall>j. J.arr j \<longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h \<Longrightarrow> ?f \<cdot> h = ?g \<cdot> h"
proof -
assume 1: "\<forall>j. J.arr j \<longrightarrow> ?\<chi> j \<cdot> h = ?\<chi>' j \<cdot> h"
have 2: "\<And>j. j \<in> Collect J.arr \<Longrightarrow> \<pi>a j \<cdot> ?f \<cdot> h = \<pi>a j \<cdot> ?g \<cdot> h"
proof -
fix j
assume j: "j \<in> Collect J.arr"
have "\<pi>a j \<cdot> ?f \<cdot> h = (\<pi>a j \<cdot> ?f) \<cdot> h"
using comp_assoc by simp
also have "... = ?\<chi> j \<cdot> h"
using ff j by force
also have "... = ?\<chi>' j \<cdot> h"
using 1 j by auto
also have "... = (\<pi>a j \<cdot> ?g) \<cdot> h"
using gg j by force
also have "... = \<pi>a j \<cdot> ?g \<cdot> h"
using comp_assoc by simp
finally show "\<pi>a j \<cdot> ?f \<cdot> h = \<pi>a j \<cdot> ?g \<cdot> h"
by auto
qed
show "C ?f h = C ?g h"
proof -
have "\<And>j. Arr.arr j \<Longrightarrow> \<guillemotleft>\<pi>a j \<cdot> ?f \<cdot> h : dom h \<rightarrow> \<Delta>a.map j\<guillemotright>"
using f_in_hom h \<pi>a_in_hom by (elim in_homE, auto)
hence 3: "\<exists>!k. \<guillemotleft>k : dom h \<rightarrow> \<Pi>a\<guillemotright> \<and> (\<forall>j. Arr.arr j \<longrightarrow> \<pi>a j \<cdot> k = \<pi>a j \<cdot> ?f \<cdot> h)"
using h \<pi>a \<pi>a.is_universal' [of "dom h" "\<lambda>j. \<pi>a j \<cdot> ?f \<cdot> h"] \<Delta>a.map_def
ide_dom [of h]
by blast
have 4: "\<And>P x x'. \<exists>!k. P k x \<Longrightarrow> P x x \<Longrightarrow> P x' x \<Longrightarrow> x' = x" by auto let ?P = "\<lambda> k x. \<guillemotleft>k : dom h \<rightarrow> \<Pi>a\<guillemotright> \<and>
(\<forall>j. j \<in> Collect J.arr \<longrightarrow> \<pi>a j \<cdot> k = \<pi>a j \<cdot> x)"
have "?P (?g \<cdot> h) (?g \<cdot> h)"
using g_in_hom h by force
moreover have "?P (?f \<cdot> h) (?g \<cdot> h)"
using 2 f_in_hom g_in_hom h by force
ultimately show ?thesis
using 34 [of ?P "?f \<cdot> h""?g \<cdot> h"] by auto
qed
qed
qed
have E': "\<And>e. \<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright> \<Longrightarrow>
?f \<cdot> e = ?g \<cdot> e \<longleftrightarrow>
(\<forall>j. J.arr j \<longrightarrow>
(D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> e) \<cdot> dom e = D j \<cdot> \<pi>o (J.dom j) \<cdot> e)"
proof -
have 1: "\<And>e j. \<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright> \<Longrightarrow> J.arr j \<Longrightarrow>
?\<chi> j \<cdot> e = (D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> e) \<cdot> dom e"
proof -
fix e j
assume e: "\<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright>"
assume j: "J.arr j"
have "\<guillemotleft>\<pi>o (J.cod j) \<cdot> e : dom e \<rightarrow> D (J.cod j)\<guillemotright>"
using e j \<pi>o_in_hom by auto
thus "?\<chi> j \<cdot> e = (D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> e) \<cdot> dom e"
using j comp_arr_dom comp_cod_arr by (elim in_homE, auto)
qed
have 2: "\<And>e j. \<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright> \<Longrightarrow> J.arr j \<Longrightarrow> ?\<chi>' j \<cdot> e = D j \<cdot> \<pi>o (J.dom j) \<cdot> e"
by (simp add: comp_assoc)
show "\<And>e. \<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright> \<Longrightarrow>
?f \<cdot> e = ?g \<cdot> e \<longleftrightarrow>
(\<forall>j. J.arr j \<longrightarrow>
(D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> e) \<cdot> dom e = D j \<cdot> \<pi>o (J.dom j) \<cdot> e)"
using 12 E by presburger
qed
text\<open>
The composites of @{term e} with the projections from the product @{term \<Pi>o}
determine a limit cone @{term \<mu>} for @{term D}. The component of @{term \<mu>}
at an object @{term j} of @{term[source=true] J} is the composite @{term "C (\<pi>o j) e"}.
However, we need to extend @{term \<mu>} to all arrows @{term j} of @{term[source=true] J},
so the correct definition is @{term "\<mu> j = C (D j) (C (\<pi>o (J.dom j)) e)"}.
\<close>
have e_in_hom: "\<guillemotleft>e : dom e \<rightarrow> \<Pi>o\<guillemotright>"
using EQU.equalizes f_in_hom in_homI
by (metis (no_types, lifting) seqE in_homE)
have e_map: "C ?f e = C ?g e"
using EQU.equalizes f_in_hom in_homI by fastforce
interpret domE: constant_functor J C \<open>dom e\<close>
using e_in_hom by (unfold_locales, auto) let ?\<mu> = "\<lambda>j. if J.arr j then D j \<cdot> \<pi>o (J.dom j) \<cdot> e else null"
have \<mu>: "\<And>j. J.arr j \<Longrightarrow> \<guillemotleft>?\<mu> j : dom e \<rightarrow> D (J.cod j)\<guillemotright>"
proof -
fix j
assume j: "J.arr j"
show "\<guillemotleft>?\<mu> j : dom e \<rightarrow> D (J.cod j)\<guillemotright>"
using j e_in_hom \<pi>o_in_hom [of"J.dom j"] by auto
qed
interpret \<mu>: cone J C D \<open>dom e\<close> ?\<mu>
using \<mu> comp_cod_arr e_in_hom e_map E'
apply unfold_locales
apply auto
by (metis D.as_nat_trans.naturality1 comp_assoc)
text\<open> If @{term \<tau>} is any cone over @{term D} then @{term \<tau>} restricts to a cone over
@{term \<Delta>o} for which the induced arrow to @{term \<Pi>o} equalizes @{term f} and @{term g}.
\<close>
have R: "\<And>a \<tau>. cone J C D a \<tau> \<Longrightarrow>
cone Obj.comp C \<Delta>o.map a (\<Delta>o.mkCone \<tau>) \<and>
?f \<cdot> \<pi>o.induced_arrow a (\<Delta>o.mkCone \<tau>)
= ?g \<cdot> \<pi>o.induced_arrow a (\<Delta>o.mkCone \<tau>)"
proof -
fix a \<tau>
assume cone_\<tau>: "cone J C D a \<tau>"
interpret \<tau>: cone J C D a \<tau> using cone_\<tau> by auto
interpret A: constant_functor Obj.comp C a
using \<tau>.ide_apex by (unfold_locales, auto)
interpret \<tau>o: cone Obj.comp C \<Delta>o.map a \<open>\<Delta>o.mkCone \<tau>\<close>
using A.value_is_ide \<Delta>o.map_def comp_cod_arr comp_arr_dom
by (unfold_locales, auto) let ?e = "\<pi>o.induced_arrow a (\<Delta>o.mkCone \<tau>)"
have mkCone_\<tau>: "\<Delta>o.mkCone \<tau> \<in> \<Delta>o.cones a"
using \<tau>o.cone_axioms by auto
have e: "\<guillemotleft>?e : a \<rightarrow> \<Pi>o\<guillemotright>"
using mkCone_\<tau> \<pi>o.induced_arrowI by simp
have ee: "\<And>j. J.ide j \<Longrightarrow> \<pi>o j \<cdot> ?e = \<tau> j"
proof -
fix j
assume j: "J.ide j"
have "\<pi>o j \<cdot> ?e = \<Delta>o.cones_map ?e \<pi>o j"
using j e \<pi>o.cone_axioms by force
also have "... = \<Delta>o.mkCone \<tau> j"
using j mkCone_\<tau> \<pi>o.induced_arrowI [of"\<Delta>o.mkCone \<tau>" a] by fastforce
also have "... = \<tau> j"
using j by simp
finally show "\<pi>o j \<cdot> ?e = \<tau> j" by auto
qed
have "\<And>j. J.arr j \<Longrightarrow>
(D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> ?e) \<cdot> dom ?e = D j \<cdot> \<pi>o (J.dom j) \<cdot> ?e"
proof -
fix j
assume j: "J.arr j"
have 1: "\<guillemotleft>\<pi>o (J.cod j) : \<Pi>o \<rightarrow> D (J.cod j)\<guillemotright>" using j \<pi>o_in_hom by simp
have 2: "(D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> ?e) \<cdot> dom ?e
= D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> ?e"
proof -
have "seq (D (J.cod j)) (\<pi>o (J.cod j))"
using j 1 by auto
moreover have "seq (\<pi>o (J.cod j)) ?e"
using j e by fastforce
ultimately show ?thesis using comp_arr_dom by auto
qed
also have 3: "... = \<pi>o (J.cod j) \<cdot> ?e"
using j e 1 comp_cod_arr by (elim in_homE, auto)
also have "... = D j \<cdot> \<pi>o (J.dom j) \<cdot> ?e"
using j e ee 23 \<tau>.naturality \<tau>.A.map_simp \<tau>.ide_apex comp_cod_arr by auto
finally show "(D (J.cod j) \<cdot> \<pi>o (J.cod j) \<cdot> ?e) \<cdot> dom ?e = D j \<cdot> \<pi>o (J.dom j) \<cdot> ?e"
by auto
qed
hence "C ?f ?e = C ?g ?e"
using E' \<pi>o.induced_arrowI \<tau>o.cone_axioms mem_Collect_eq by blast
thus "cone Obj.comp C \<Delta>o.map a (\<Delta>o.mkCone \<tau>) \<and> C ?f ?e = C ?g ?e"
using \<tau>o.cone_axioms by auto
qed
text\<open>
Finally, show that @{term \<mu>} is a limit cone.
\<close>
interpret \<mu>: limit_cone J C D \<open>dom e\<close> ?\<mu>
proof
fix a \<tau>
assume cone_\<tau>: "cone J C D a \<tau>"
interpret \<tau>: cone J C D a \<tau> using cone_\<tau> by auto
interpret A: constant_functor Obj.comp C a
using \<tau>.ide_apex by unfold_locales auto
have cone_\<tau>o: "cone Obj.comp C \<Delta>o.map a (\<Delta>o.mkCone \<tau>)"
using A.value_is_ide \<Delta>o.map_def D.preserves_ide comp_cod_arr comp_arr_dom
\<tau>.preserves_hom
by unfold_locales auto
show "\<exists>!h. \<guillemotleft>h : a \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h ?\<mu> = \<tau>"
proof let ?e' = "\<pi>o.induced_arrow a (\<Delta>o.mkCone \<tau>)"
have e'_in_hom: "\<guillemotleft>?e' : a \<rightarrow> \<Pi>o\<guillemotright>"
using cone_\<tau> R \<pi>o.induced_arrowI by auto
have e'_map: "?f \<cdot> ?e' = ?g \<cdot> ?e' \<and> \<Delta>o.cones_map ?e' \<pi>o = \<Delta>o.mkCone \<tau>"
using cone_\<tau> R \<pi>o.induced_arrowI [of"\<Delta>o.mkCone \<tau>" a] by auto
have equ: "PP.is_equalized_by ?e'"
using e'_map e'_in_hom f_in_hom seqI' by blast let ?h = "EQU.induced_arrow a (PP.mkCone ?e')"
have h_in_hom: "\<guillemotleft>?h : a \<rightarrow> dom e\<guillemotright>"
using EQU.induced_arrowI PP.cone_mkCone [of ?e'] e'_in_hom equ by fastforce
have h_map: "PP.cones_map ?h (PP.mkCone e) = PP.mkCone ?e'"
using EQU.induced_arrowI [of"PP.mkCone ?e'" a] PP.cone_mkCone [of ?e']
e'_in_hom equ
by fastforce
have 3: "D.cones_map ?h ?\<mu> = \<tau>"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> D.cones_map ?h ?\<mu> j = \<tau> j"
using h_in_hom \<mu>.cone_axioms cone_\<tau> \<tau>.extensionality by force
moreover have "J.arr j \<Longrightarrow> D.cones_map ?h ?\<mu> j = \<tau> j"
proof -
fix j
assume j: "J.arr j"
have 1: "\<guillemotleft>\<pi>o (J.dom j) \<cdot> e : dom e \<rightarrow> D (J.dom j)\<guillemotright>"
using j e_in_hom \<pi>o_in_hom [of"J.dom j"] by auto
have "D.cones_map ?h ?\<mu> j = ?\<mu> j \<cdot> ?h"
using h_in_hom j \<mu>.cone_axioms by auto
also have "... = D j \<cdot> (\<pi>o (J.dom j) \<cdot> e) \<cdot> ?h"
using j comp_assoc by simp
also have "... = D j \<cdot> \<tau> (J.dom j)"
proof -
have "(\<pi>o (J.dom j) \<cdot> e) \<cdot> ?h = \<tau> (J.dom j)"
proof -
have "(\<pi>o (J.dom j) \<cdot> e) \<cdot> ?h = \<pi>o (J.dom j) \<cdot> e \<cdot> ?h"
using j 1 e_in_hom h_in_hom \<pi>o arrI comp_assoc by auto
also have "... = \<pi>o (J.dom j) \<cdot> ?e'"
using equ e'_in_hom EQU.induced_arrowI' [of ?e'] by auto
also have "... = \<Delta>o.cones_map ?e' \<pi>o (J.dom j)"
using j e'_in_hom \<pi>o.cone_axioms by auto
also have "... = \<tau> (J.dom j)"
using j e'_map by simp
finally show ?thesis by auto
qed
thus ?thesis by simp
qed
also have "... = \<tau> j"
using j \<tau>.naturality1 by simp
finally show "D.cones_map ?h ?\<mu> j = \<tau> j" by auto
qed
ultimately show "D.cones_map ?h ?\<mu> j = \<tau> j" by auto
qed
show "\<guillemotleft>?h : a \<rightarrow> dom e\<guillemotright> \<and> D.cones_map ?h ?\<mu> = \<tau>"
using h_in_hom 3 by simp
show "\<And>h'. \<guillemotleft>h' : a \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h' ?\<mu> = \<tau> \<Longrightarrow> h' = ?h"
proof -
fix h'
assume h': "\<guillemotleft>h' : a \<rightarrow> dom e\<guillemotright> \<and> D.cones_map h' ?\<mu> = \<tau>"
have h'_in_hom: "\<guillemotleft>h' : a \<rightarrow> dom e\<guillemotright>" using h' by simp
have h'_map: "D.cones_map h' ?\<mu> = \<tau>" using h' by simp
show "h' = ?h"
proof -
have 1: "\<guillemotleft>e \<cdot> h' : a \<rightarrow> \<Pi>o\<guillemotright> \<and> ?f \<cdot> e \<cdot> h' = ?g \<cdot> e \<cdot> h' \<and>
\<Delta>o.cones_map (C e h') \<pi>o = \<Delta>o.mkCone \<tau>"
proof -
have 2: "\<guillemotleft>e \<cdot> h' : a \<rightarrow> \<Pi>o\<guillemotright>" using h'_in_hom e_in_hom by auto
moreover have "?f \<cdot> e \<cdot> h' = ?g \<cdot> e \<cdot> h'"
by (metis (no_types, lifting) EQU.equalizes comp_assoc)
moreover have "\<Delta>o.cones_map (e \<cdot> h') \<pi>o = \<Delta>o.mkCone \<tau>"
proof
have "\<Delta>o.cones_map (e \<cdot> h') \<pi>o = \<Delta>o.cones_map h' (\<Delta>o.cones_map e \<pi>o)"
using \<pi>o.cone_axioms e_in_hom h'_in_hom \<Delta>o.cones_map_comp [of e h']
by fastforce
fix j
have "\<not>Obj.arr j \<Longrightarrow> \<Delta>o.cones_map (e \<cdot> h') \<pi>o j = \<Delta>o.mkCone \<tau> j"
using 2 e_in_hom h'_in_hom \<pi>o.cone_axioms by auto
moreover have "Obj.arr j \<Longrightarrow> \<Delta>o.cones_map (e \<cdot> h') \<pi>o j = \<Delta>o.mkCone \<tau> j"
proof -
assume j: "Obj.arr j"
have "\<Delta>o.cones_map (e \<cdot> h') \<pi>o j = \<pi>o j \<cdot> e \<cdot> h'"
using 2 j \<pi>o.cone_axioms by auto
also have "... = (\<pi>o j \<cdot> e) \<cdot> h'"
using comp_assoc by auto
also have "... = \<Delta>o.mkCone ?\<mu> j \<cdot> h'"
using j e_in_hom \<pi>o_in_hom comp_ide_arr [of"D j""\<pi>o j \<cdot> e"]
by fastforce
also have "... = \<Delta>o.mkCone \<tau> j"
using j h' \<mu>.cone_axioms mem_Collect_eq by auto
finally show "\<Delta>o.cones_map (e \<cdot> h') \<pi>o j = \<Delta>o.mkCone \<tau> j" by auto
qed
ultimately show "\<Delta>o.cones_map (e \<cdot> h') \<pi>o j = \<Delta>o.mkCone \<tau> j" by auto
qed
ultimately show ?thesis by auto
qed
have "\<guillemotleft>e \<cdot> h' : a \<rightarrow> \<Pi>o\<guillemotright>" using 1 by simp
moreover have "e \<cdot> h' = ?e'"
using 1 cone_\<tau>o e'_in_hom e'_map \<pi>o.is_universal \<pi>o by blast
ultimately show "h' = ?h"
using 1 h'_in_hom h'_map EQU.is_universal' [of "e \<cdot> h'"]
EQU.induced_arrowI' [of ?e'] equ
by (elim in_homE) auto
qed
qed
qed
qed
have "limit_cone J C D (dom e) ?\<mu>" ..
thus "\<exists>a \<mu>. limit_cone J C D a \<mu>" by auto
qed
thus "\<forall>D. diagram J C D \<longrightarrow> (\<exists>a \<mu>. limit_cone J C D a \<mu>)" by blast
qed
end
section "Limits in a Set Category"
text\<open> In this section, we consider the special caseof limits in a set category.
\<close>
locale diagram_in_set_category =
J: category J +
S: set_category S is_set +
diagram J S D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and S :: "'s comp" (infixr \<open>\<cdot>\<close> 55) and is_set :: "'s set \<Rightarrow> bool" and D :: "'j \<Rightarrow> 's" begin
text\<open>
An object @{term a} of a set category @{term[source=true] S} is a limit of a diagram in
@{term[source=true] S} ifand only if there is a bijection between the set
@{term "S.hom S.unity a"} of points of @{term a} and the setof cones over the diagram
that have apex @{term S.unity}.
\<close>
lemma limits_are_sets_of_cones:
shows "has_as_limit a \<longleftrightarrow> S.ide a \<and> (\<exists>\<phi>. bij_betw \<phi> (S.hom S.unity a) (cones S.unity))"
proof
text\<open> If \<open>has_limit a\<close>, then by the universal property of the limit cone,
composition in @{term[source=true] S} yields a bijection between @{term "S.hom S.unity a"} and @{term "cones S.unity"}.
\<close>
assume a: "has_as_limit a"
hence "S.ide a"
using limit_cone_def cone.ide_apex by metis
from a obtain \<chi> where \<chi>: "limit_cone a \<chi>" by auto
interpret \<chi>: limit_cone J S D a \<chi> using \<chi> by auto
have "bij_betw (\<lambda>f. cones_map f \<chi>) (S.hom S.unity a) (cones S.unity)"
using \<chi>.bij_betw_hom_and_cones S.ide_unity by simp
thus "S.ide a \<and> (\<exists>\<phi>. bij_betw \<phi> (S.hom S.unity a) (cones S.unity))"
using \<open>S.ide a\<close> by blast
next
text\<open>
Conversely, an arbitrary bijection @{term \<phi>} between @{term "S.hom S.unity a"} and cones unity extends pointwise to a natural bijection @{term "\<Phi> a'"} between
@{term "S.hom a' a"} and @{term "cones a'"}, showing that @{term a} is a limit.
In more detail, the hypotheses give us a correspondence between points of @{term a} and cones with apex @{term "S.unity"}. We extend this to a correspondence between
functions to @{term a} and general cones, with each arrow from @{term a'} to @{term a}
determining a cone with apex @{term a'}. If @{term "f \<in> hom a' a"} then composition with @{term f} takes each point @{term y} of @{term a'} to the point @{term "S f y"} of @{term a}. To this we may apply the given bijection @{term \<phi>} to obtain
@{term "\<phi> (S f y) \<in> cones S.unity"}. The component @{term "\<phi> (S f y) j"} at @{term j} of this cone is a point of @{term "S.cod (D j)"}. Thus, @{term "f \<in> hom a' a"} determines
a cone @{term \<chi>f} with apex @{term a'} whose component at @{term j} is the
unique arrow @{term "\<chi>f j"} of @{term[source=true] S} such that
@{term "\<chi>f j \<in> hom a' (cod (D j))"} and @{term "S (\<chi>f j) y = \<phi> (S f y) j"}
for all points @{term y} of @{term a'}.
The cone @{term \<chi>a} corresponding to @{term "a \<in> S.hom a a"} is then a limit cone.
\<close>
assume a: "S.ide a \<and> (\<exists>\<phi>. bij_betw \<phi> (S.hom S.unity a) (cones S.unity))"
hence ide_a: "S.ide a" by auto
show "has_as_limit a"
proof -
from a obtain \<phi> where \<phi>: "bij_betw \<phi> (S.hom S.unity a) (cones S.unity)" by blast
have X: "\<And>f j y. \<lbrakk> \<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright>; J.arr j; \<guillemotleft>y : S.unity \<rightarrow> S.dom f\<guillemotright> \<rbrakk>
\<Longrightarrow> \<guillemotleft>\<phi> (f \<cdot> y) j : S.unity \<rightarrow> S.cod (D j)\<guillemotright>"
proof -
fix f j y
assume f: "\<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright>"and j: "J.arr j"and y: "\<guillemotleft>y : S.unity \<rightarrow> S.dom f\<guillemotright>"
interpret \<chi>: cone J S D S.unity \<open>\<phi> (S f y)\<close>
using f y \<phi> bij_betw_imp_funcset funcset_mem by blast
show "\<guillemotleft>\<phi> (f \<cdot> y) j : S.unity \<rightarrow> S.cod (D j)\<guillemotright>" using j by auto
qed
text\<open>
We want to define the component @{term "\<chi>j \<in> S.hom (S.dom f) (S.cod (D j))"}
at @{term j} of a cone by specifying how it acts by composition on points
@{term "y \<in> S.hom S.unity (S.dom f)"}. We can do this because @{term[source=true] S}
is a set category.
\<close> let ?P = "\<lambda>f j \<chi>j. \<guillemotleft>\<chi>j : S.dom f \<rightarrow> S.cod (D j)\<guillemotright> \<and>
(\<forall>y. \<guillemotleft>y : S.unity \<rightarrow> S.dom f\<guillemotright> \<longrightarrow> \<chi>j \<cdot> y = \<phi> (f \<cdot> y) j)" let ?\<chi> = "\<lambda>f j. if J.arr j then (THE \<chi>j. ?P f j \<chi>j) else S.null"
have \<chi>: "\<And>f j. \<lbrakk> \<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright>; J.arr j \<rbrakk> \<Longrightarrow> ?P f j (?\<chi> f j)"
proof -
fix b f j
assume f: "\<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright>"and j: "J.arr j"
interpret B: constant_functor J S \<open>S.dom f\<close>
using f by (unfold_locales) auto
have "(\<lambda>y. \<phi> (f \<cdot> y) j) \<in> S.hom S.unity (S.dom f) \<rightarrow> S.hom S.unity (S.cod (D j))"
using f j X Pi_I' by simp
hence "\<exists>!\<chi>j. ?P f j \<chi>j"
using f j S.fun_complete' by (elim S.in_homE) auto
thus "?P f j (?\<chi> f j)" using j theI' [of "?P f j"] by simp
qed
text\<open>
The arrows @{term "\<chi> f j"} are in fact the components of a cone with apex
@{term "S.dom f"}.
\<close>
have cone: "\<And>f. \<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright> \<Longrightarrow> cone (S.dom f) (?\<chi> f)"
proof -
fix f
assume f: "\<guillemotleft>f : S.dom f \<rightarrow> a\<guillemotright>"
interpret B: constant_functor J S \<open>S.dom f\<close>
using f by unfold_locales auto
show "cone (S.dom f) (?\<chi> f)"
proof
show "\<And>j. \<not>J.arr j \<Longrightarrow> ?\<chi> f j = S.null" by simp
fix j
assume j: "J.arr j"
have 0: "\<guillemotleft>?\<chi> f j : S.dom f \<rightarrow> S.cod (D j)\<guillemotright>" using f j \<chi> by simp
show "S.arr (?\<chi> f j)" using f j \<chi> by auto
have par2: "S.par (?\<chi> f (J.cod j) \<cdot> B.map j) (?\<chi> f j)"
using f j 0 \<chi> [of f "J.cod j"] by (elim S.in_homE, auto)
have nat: "\<And>y. \<guillemotleft>y : S.unity \<rightarrow> S.dom f\<guillemotright> \<Longrightarrow>
(D j \<cdot> ?\<chi> f (J.dom j)) \<cdot> y = ?\<chi> f j \<cdot> y \<and>
(?\<chi> f (J.cod j) \<cdot> B.map j) \<cdot> y = ?\<chi> f j \<cdot> y"
proof -
fix y
assume y: "\<guillemotleft>y : S.unity \<rightarrow> S.dom f\<guillemotright>"
show "(D j \<cdot> ?\<chi> f (J.dom j)) \<cdot> y = ?\<chi> f j \<cdot> y \<and>
(?\<chi> f (J.cod j) \<cdot> B.map j) \<cdot> y = ?\<chi> f j \<cdot> y"
proof
have 1: "\<phi> (f \<cdot> y) \<in> cones S.unity"
using f y \<phi> bij_betw_imp_funcset PiE
S.seqI S.cod_comp S.dom_comp mem_Collect_eq
by fastforce
interpret \<chi>: cone J S D S.unity \<open>\<phi> (f \<cdot> y)\<close>
using 1 by simp
show "(D j \<cdot> ?\<chi> f (J.dom j)) \<cdot> y = ?\<chi> f j \<cdot> y"
using J.arr_dom S.comp_assoc \<chi> \<chi>.naturality1 f j y by presburger
have "(?\<chi> f (J.cod j) \<cdot> B.map j) \<cdot> y = ?\<chi> f (J.cod j) \<cdot> y"
using j B.map_simp par2 B.value_is_ide S.comp_arr_ide
by (metis (no_types, lifting))
also have "... = \<phi> (f \<cdot> y) (J.cod j)"
using f y \<chi> \<chi>.extensionality by simp
also have "... = \<phi> (f \<cdot> y) j"
using j \<chi>.naturality2
by (metis J.arr_cod \<chi>.A.map_simp J.cod_cod)
also have "... = ?\<chi> f j \<cdot> y"
using f y \<chi> \<chi>.extensionality by simp
finally show "(?\<chi> f (J.cod j) \<cdot> B.map j) \<cdot> y = ?\<chi> f j \<cdot> y" by auto
qed
qed
show "D j \<cdot> ?\<chi> f (J.dom j) = ?\<chi> f j"
proof -
have "S.par (D j \<cdot> ?\<chi> f (J.dom j)) (?\<chi> f j)"
using f j 0 \<chi> [of f "J.dom j"] by (elim S.in_homE, auto)
thus ?thesis
using nat 0
apply (intro S.arr_eqI'\<^sub>S\<^sub>C [of "D j \<cdot> ?\<chi> f (J.dom j)" "?\<chi> f j"])
apply force
by auto
qed
show "?\<chi> f (J.cod j) \<cdot> B.map j = ?\<chi> f j"
using par2 nat 0 f j \<chi>
apply (intro S.arr_eqI'\<^sub>S\<^sub>C [of "?\<chi> f (J.cod j) \<cdot> B.map j" "?\<chi> f j"])
apply force
by (metis (no_types, lifting) S.in_homE)
qed
qed
interpret \<chi>a: cone J S D a \<open>?\<chi> a\<close> using a cone [of a] by fastforce
text\<open>
Finally, show that \<open>\<chi> a\<close> is a limit cone.
\<close>
interpret \<chi>a: limit_cone J S D a \<open>?\<chi> a\<close>
proof
fix a' \<chi>'
assume cone_\<chi>': "cone a' \<chi>'"
interpret \<chi>': cone J S D a' \<chi>' using cone_\<chi>' by auto
show "\<exists>!f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and> cones_map f (?\<chi> a) = \<chi>'"
proof let ?\<psi> = "inv_into (S.hom S.unity a) \<phi>"
have \<psi>: "?\<psi> \<in> cones S.unity \<rightarrow> S.hom S.unity a"
using \<phi> bij_betw_inv_into bij_betwE by blast let ?P = "\<lambda>f. \<guillemotleft>f : a' \<rightarrow> a\<guillemotright> \<and>
(\<forall>y. y \<in> S.hom S.unity a' \<longrightarrow> f \<cdot> y = ?\<psi> (cones_map y \<chi>'))"
have 1: "\<exists>!f. ?P f"
proof -
have "(\<lambda>y. ?\<psi> (cones_map y \<chi>')) \<in> S.hom S.unity a' \<rightarrow> S.hom S.unity a"
proof
fix x
assume "x \<in> S.hom S.unity a'"
hence "\<guillemotleft>x : S.unity \<rightarrow> a'\<guillemotright>" by simp
hence "cones_map x \<in> cones a' \<rightarrow> cones S.unity"
using cones_map_mapsto [of x] by (elim S.in_homE) auto
hence "cones_map x \<chi>' \<in> cones S.unity"
using cone_\<chi>' by blast
thus "?\<psi> (cones_map x \<chi>') \<in> S.hom S.unity a"
using \<psi> by auto
qed
thus ?thesis
using S.fun_complete' a \<chi>'.ide_apex by simp
qed let ?f = "THE f. ?P f"
have f: "?P ?f" using 1 theI' [of ?P] by simp
have f_in_hom: "\<guillemotleft>?f : a' \<rightarrow> a\<guillemotright>" using f by simp
have f_map: "cones_map ?f (?\<chi> a) = \<chi>'"
proof -
have 1: "cone a' (cones_map ?f (?\<chi> a))"
proof -
have "cones_map ?f \<in> cones a \<rightarrow> cones a'"
using f_in_hom cones_map_mapsto [of ?f] by (elim S.in_homE) auto
hence "cones_map ?f (?\<chi> a) \<in> cones a'"
using \<chi>a.cone_axioms by blast
thus ?thesis by simp
qed
interpret f\<chi>a: cone J S D a' \<open>cones_map ?f (?\<chi> a)\<close>
using 1 by simp
show ?thesis
proof
fix j
have "\<not>J.arr j \<Longrightarrow> cones_map ?f (?\<chi> a) j = \<chi>' j"
using 1 \<chi>'.extensionality f\<chi>a.extensionality by presburger
moreover have "J.arr j \<Longrightarrow> cones_map ?f (?\<chi> a) j = \<chi>' j"
proof -
assume j: "J.arr j"
show "cones_map ?f (?\<chi> a) j = \<chi>' j"
proof (intro S.arr_eqI'\<^sub>S\<^sub>C [of "cones_map ?f (?\<chi> a) j" "\<chi>' j"])
show par: "S.par (cones_map ?f (?\<chi> a) j) (\<chi>' j)"
using j \<chi>'.preserves_cod \<chi>'.preserves_dom \<chi>'.preserves_reflects_arr
f\<chi>a.preserves_cod f\<chi>a.preserves_dom f\<chi>a.preserves_reflects_arr
by presburger
fix y
assume "\<guillemotleft>y : S.unity \<rightarrow> S.dom (cones_map ?f (?\<chi> a) j)\<guillemotright>"
hence y: "\<guillemotleft>y : S.unity \<rightarrow> a'\<guillemotright>"
using j f\<chi>a.preserves_dom by simp
have 1: "\<guillemotleft>?\<chi> a j : a \<rightarrow> D (J.cod j)\<guillemotright>"
using j \<chi>a.preserves_hom by force
have 2: "\<guillemotleft>?f \<cdot> y : S.unity \<rightarrow> a\<guillemotright>"
using f_in_hom y by blast
have "cones_map ?f (?\<chi> a) j \<cdot> y = (?\<chi> a j \<cdot> ?f) \<cdot> y"
proof -
have "S.cod ?f = a" using f_in_hom by blast
thus ?thesis using j \<chi>a.cone_axioms by simp
qed
also have "... = ?\<chi> a j \<cdot> ?f \<cdot> y"
using 1 j y f_in_hom S.comp_assoc S.seqI' by blast
also have "... = \<phi> (a \<cdot> ?f \<cdot> y) j"
using 12 ide_a f j y \<chi> [of a] by (simp add: S.ide_in_hom)
also have "... = \<phi> (?f \<cdot> y) j"
using a 2 y S.comp_cod_arr by (elim S.in_homE, auto)
also have "... = \<phi> (?\<psi> (cones_map y \<chi>')) j"
using j y f by simp
also have "... = cones_map y \<chi>' j"
proof -
have "cones_map y \<chi>' \<in> cones S.unity"
using cone_\<chi>' y cones_map_mapsto by force
hence "\<phi> (?\<psi> (cones_map y \<chi>')) = cones_map y \<chi>'"
using \<phi> bij_betw_inv_into_right [of \<phi>] by simp
thus ?thesis by auto
qed
also have "... = \<chi>' j \<cdot> y"
using cone_\<chi>' j y by auto
finally show "cones_map ?f (?\<chi> a) j \<cdot> y = \<chi>' j \<cdot> y"
by auto
qed
qed
ultimately show "cones_map ?f (?\<chi> a) j = \<chi>' j" by blast
qed
qed
show "\<guillemotleft>?f : a' \<rightarrow> a\<guillemotright> \<and> cones_map ?f (?\<chi> a) = \<chi>'"
using f_in_hom f_map by simp
show "\<And>f'. \<guillemotleft>f' : a' \<rightarrow> a\<guillemotright> \<and> cones_map f' (?\<chi> a) = \<chi>' \<Longrightarrow> f' = ?f"
proof -
fix f'
assume f': "\<guillemotleft>f' : a' \<rightarrow> a\<guillemotright> \<and> cones_map f' (?\<chi> a) = \<chi>'"
have f'_in_hom: "\<guillemotleft>f' : a' \<rightarrow> a\<guillemotright>" using f' by simp
have f'_map: "cones_map f' (?\<chi> a) = \<chi>'" using f' by simp
show "f' = ?f"
proof (intro S.arr_eqI'\<^sub>S\<^sub>C [of f' ?f])
show "S.par f' ?f"
using f_in_hom f'_in_hom by (elim S.in_homE, auto)
show "\<And>y'. \<guillemotleft>y' : S.unity \<rightarrow> S.dom f'\<guillemotright> \<Longrightarrow> f' \<cdot> y' = ?f \<cdot> y'"
proof -
fix y'
assume y': "\<guillemotleft>y' : S.unity \<rightarrow> S.dom f'\<guillemotright>"
have 0: "\<phi> (f' \<cdot> y') = cones_map y' \<chi>'"
proof
fix j
have 1: "\<guillemotleft>f' \<cdot> y' : S.unity \<rightarrow> a\<guillemotright>" using f'_in_hom y' by auto
hence 2: "\<phi> (f' \<cdot> y') \<in> cones S.unity"
using \<phi> bij_betw_imp_funcset [of \<phi> "S.hom S.unity a""cones S.unity"]
by auto
interpret \<chi>'': cone J S D S.unity \<open>\<phi> (f' \<cdot> y')\<close> using 2 by auto
have "\<not>J.arr j \<Longrightarrow> \<phi> (f' \<cdot> y') j = cones_map y' \<chi>' j"
using f' y' cone_\<chi>' \<chi>''.extensionality mem_Collect_eq restrict_apply
by (elim S.in_homE, auto)
moreover have "J.arr j \<Longrightarrow> \<phi> (f' \<cdot> y') j = cones_map y' \<chi>' j"
proof -
assume j: "J.arr j"
have 3: "\<guillemotleft>?\<chi> a j : a \<rightarrow> D (J.cod j)\<guillemotright>"
using j \<chi>a.preserves_hom by force
have "\<phi> (f' \<cdot> y') j = \<phi> (a \<cdot> f' \<cdot> y') j"
using a f' y' j S.comp_cod_arr by (elim S.in_homE, auto)
also have "... = ?\<chi> a j \<cdot> f' \<cdot> y'"
using 13 \<chi> [of a] a f' y' j by fastforce
also have "... = (?\<chi> a j \<cdot> f') \<cdot> y'"
using S.comp_assoc by simp
also have "... = cones_map f' (?\<chi> a) j \<cdot> y'"
using f' y' j \<chi>a.cone_axioms by auto
also have "... = \<chi>' j \<cdot> y'"
using f' by blast
also have "... = cones_map y' \<chi>' j"
using y' j cone_\<chi>' f' mem_Collect_eq restrict_apply by force
finally show "\<phi> (f' \<cdot> y') j = cones_map y' \<chi>' j" by auto
qed
ultimately show "\<phi> (f' \<cdot> y') j = cones_map y' \<chi>' j" by auto
qed
hence "f' \<cdot> y' = ?\<psi> (cones_map y' \<chi>')"
using \<phi> f'_in_hom y' S.comp_in_homI
bij_betw_inv_into_left [of \<phi> "S.hom S.unity a""cones S.unity""f' \<cdot> y'"]
by (elim S.in_homE, auto)
moreover have "?f \<cdot> y' = ?\<psi> (cones_map y' \<chi>')"
using \<phi> 01 f f_in_hom f'_in_hom y' S.comp_in_homI
bij_betw_inv_into_left [of \<phi> "S.hom S.unity a""cones S.unity""?f \<cdot> y'"]
by (elim S.in_homE, auto)
ultimately show "f' \<cdot> y' = ?f \<cdot> y'" by auto
qed
qed
qed
qed
qed
have "limit_cone a (?\<chi> a)" ..
thus ?thesis by auto
qed
qed
end
locale diagram_in_replete_set_category =
J: category J +
S: replete_set_category S +
diagram J S D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and S :: "'s comp" (infixr \<open>\<cdot>\<close> 55) and D :: "'j \<Rightarrow> 's" begin
sublocale diagram_in_set_category J S S.setp D
..
end
context set_category begin
text\<open>
A set category has an equalizer for any parallel pair of arrows.
\<close>
lemma has_equalizers\<^sub>S\<^sub>C:
shows "has_equalizers"
proof (unfold has_equalizers_def)
have "\<And>f0 f1. par f0 f1 \<Longrightarrow> \<exists>e. has_as_equalizer f0 f1 e"
proof -
fix f0 f1
assume par: "par f0 f1"
interpret J: parallel_pair .
interpret PP: parallel_pair_diagram S f0 f1
using par by unfold_locales auto
interpret PP: diagram_in_set_category J.comp S setp PP.map ..
text\<open> Let @{term a} be the object corresponding to the setofall images of equalizing points of @{term "dom f0"}, andlet @{term e} be the inclusion of @{term a} in @{term "dom f0"}.
\<close> let ?a = "mkIde (img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e})"
have 0: "{e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e} \<subseteq> hom unity (dom f0)"
by auto
hence 1: "img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e} \<subseteq> Univ"
using img_point_in_Univ by auto
have 2: "setp (img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e})"
proof -
have "setp (img ` hom unity (dom f0))"
using ide_dom par setp_img_points by blast
moreover have "img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e} \<subseteq>
img ` hom unity (dom f0)"
by blast
ultimately show ?thesis
by (meson setp_respects_subset)
qed
have ide_a: "ide ?a" using 12 ide_mkIde by auto
have set_a: "set ?a = img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e}"
using 12 set_mkIde by simp
have incl_in_a: "incl_in ?a (dom f0)"
proof -
have "ide (dom f0)"
using PP.is_parallel by simp
moreover have "set ?a \<subseteq> set (dom f0)"
using img_point_elem_set set_a by fastforce
ultimately show ?thesis
using incl_in_def \<open>ide ?a\<close> by simp
qed
text\<open> Then @{term "set a"} is in bijective correspondence with @{term "PP.cones unity"}.
\<close> let ?\<phi> = "\<lambda>t. PP.mkCone (mkPoint (dom f0) t)" let ?\<psi> = "\<lambda>\<chi>. img (\<chi> (J.Zero))"
have bij: "bij_betw ?\<phi> (set ?a) (PP.cones unity)"
proof (intro bij_betwI)
show "?\<phi> \<in> set ?a \<rightarrow> PP.cones unity"
proof
fix t
assume t: "t \<in> set ?a"
hence 1: "t \<in> img ` {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e}"
using set_a by blast then have 2: "mkPoint (dom f0) t \<in> hom unity (dom f0)"
using mkPoint_in_hom imageE mem_Collect_eq mkPoint_img(2) by auto with1 have 3: "mkPoint (dom f0) t \<in> {e. e \<in> hom unity (dom f0) \<and> f0 \<cdot> e = f1 \<cdot> e}"
using mkPoint_img(2) by auto then have "PP.is_equalized_by (mkPoint (dom f0) t)"
using CollectD par by fastforce
thus "PP.mkCone (mkPoint (dom f0) t) \<in> PP.cones unity"
using 2 PP.cone_mkCone [of"mkPoint (dom f0) t"] by auto
qed
show "?\<psi> \<in> PP.cones unity \<rightarrow> set ?a"
proof
fix \<chi>
assume \<chi>: "\<chi> \<in> PP.cones unity"
interpret \<chi>: cone J.comp S PP.map unity \<chi> using \<chi> by auto
have "\<chi> (J.Zero) \<in> hom unity (dom f0) \<and> f0 \<cdot> \<chi> (J.Zero) = f1 \<cdot> \<chi> (J.Zero)"
using \<chi> PP.map_def PP.is_equalized_by_cone J.arr_char by auto
hence "img (\<chi> (J.Zero)) \<in> set ?a"
using set_a by simp
thus "?\<psi> \<chi> \<in> set ?a" by blast
qed
show "\<And>t. t \<in> set ?a \<Longrightarrow> ?\<psi> (?\<phi> t) = t"
using set_a J.arr_char PP.mkCone_def imageE mem_Collect_eq mkPoint_img(2)
by auto
show "\<And>\<chi>. \<chi> \<in> PP.cones unity \<Longrightarrow> ?\<phi> (?\<psi> \<chi>) = \<chi>"
proof -
fix \<chi>
assume \<chi>: "\<chi> \<in> PP.cones unity"
interpret \<chi>: cone J.comp S PP.map unity \<chi> using \<chi> by auto
have 1: "\<chi> (J.Zero) \<in> hom unity (dom f0) \<and> f0 \<cdot> \<chi> (J.Zero) = f1 \<cdot> \<chi> (J.Zero)"
using \<chi> PP.map_def PP.is_equalized_by_cone J.arr_char by auto
hence "img (\<chi> (J.Zero)) \<in> set ?a"
using set_a by simp
hence "img (\<chi> (J.Zero)) \<in> set (dom f0)"
using incl_in_a incl_in_def by auto
hence "mkPoint (dom f0) (img (\<chi> J.Zero)) = \<chi> J.Zero"
using 1 mkPoint_img(2) by blast
hence "?\<phi> (?\<psi> \<chi>) = PP.mkCone (\<chi> J.Zero)" by simp
also have "... = \<chi>"
using \<chi> PP.mkCone_cone by simp
finally show "?\<phi> (?\<psi> \<chi>) = \<chi>" by auto
qed
qed
text\<open>
It follows that @{term a} is a limit of \<open>PP\<close>, and that the limit cone gives an
equalizer of @{term f0} and @{term f1}.
\<close>
have "PP.has_as_limit ?a"
proof -
have "\<exists>\<mu>. bij_betw \<mu> (hom unity ?a) (set ?a)"
using bij_betw_points_and_set ide_a by auto
from this obtain \<mu> where \<mu>: "bij_betw \<mu> (hom unity ?a) (set ?a)" by blast
have "bij_betw (?\<phi> o \<mu>) (hom unity ?a) (PP.cones unity)"
using bij \<mu> bij_betw_comp_iff by blast
hence "\<exists>\<phi>. bij_betw \<phi> (hom unity ?a) (PP.cones unity)" by auto
thus ?thesis
using ide_a PP.limits_are_sets_of_cones by simp
qed
from this obtain \<epsilon> where \<epsilon>: "limit_cone J.comp S PP.map ?a \<epsilon>" by auto
have "PP.has_as_equalizer (\<epsilon> J.Zero)"
proof -
interpret \<epsilon>: limit_cone J.comp S PP.map ?a \<epsilon> using \<epsilon> by auto
have "PP.mkCone (\<epsilon> (J.Zero)) = \<epsilon>"
using \<epsilon> PP.mkCone_cone \<epsilon>.cone_axioms by simp
moreover have "dom (\<epsilon> (J.Zero)) = ?a"
using J.ide_char \<epsilon>.preserves_hom \<epsilon>.A.map_def by simp
ultimately show ?thesis
using \<epsilon> by simp
qed
thus "\<exists>e. has_as_equalizer f0 f1 e"
using par has_as_equalizer_def by auto
qed
thus "\<forall>f0 f1. par f0 f1 \<longrightarrow> (\<exists>e. has_as_equalizer f0 f1 e)" by auto
qed
end
sublocale set_category \<subseteq> category_with_equalizers S
apply unfold_locales using has_equalizers\<^sub>S\<^sub>C by auto
context set_category begin
text\<open>
The aim of the next results is to characterize the conditions under which a set
category has products. In a traditional development of category theory,
one shows that the category \textbf{Set} of \emph{all} sets has all small
(\emph{i.e.}~set-indexed) products. In the present context we donot have a
category of \emph{all} sets, but rather only a category ofall sets with
elements at a particular type. Clearly, we cannot expect such a category
to have products indexed by arbitrarily large sets. The existence of
@{term I}-indexed products in a set category @{term[source=true] S} implies that the universe
\<open>S.Univ\<close> of @{term[source=true] S} must be large enough to admit the formation of
@{term I}-tuples of its elements. Conversely, for a set category @{term[source=true] S}
the ability to form @{term I}-tuples in @{term Univ} implies that
@{term[source=true] S} has @{term I}-indexed products. Below we make this precise by
defining the notion of when a set category @{term[source=true] S}
``admits @{term I}-indexed tupling''and we show that @{term[source=true] S}
has @{term I}-indexed products ifand only if it admits @{term I}-indexed tupling.
The definition of ``@{term[source=true] S} admits @{term I}-indexed tupling'' says that
there is an injective map, from the space of extensional functions from
@{term I} to @{term Univ}, to @{term Univ}. However for a convenient
statement and proof of the desired result, the definition of extensional
function from theory @{theory "HOL-Library.FuncSet"} needs to be modified.
The theory @{theory "HOL-Library.FuncSet"} uses the definite, but arbitrarily chosen value
@{term undefined} as the value to be assumed by an extensional function outside of its domain. In the context of the \<open>set_category\<close>, though, it is
more natural to use \<open>S.unity\<close>, which is guaranteed to be an element of the
universe of @{term[source=true] S}, for this purpose. Doing things that way makes it
simpler to establish a bijective correspondence between cones over @{term D} with apex
@{term unity} and the setof extensional functions @{term d} that map
each arrow @{term j} of @{term J} to an element @{term "d j"} of @{term "set (D j)"}.
Possibly it makes sense to go back and make this change in \<open>set_category\<close>,
but that would mean completely abandoning @{theory "HOL-Library.FuncSet"} and essentially
introducing a duplicate version for use with \<open>set_category\<close>.
As a compromise, what I have done here is to locally redefine the few notions from
@{theory "HOL-Library.FuncSet"} that I need in order to prove the next setof results.
The redefined notions are primed to avoid confusion with the original versions.
\<close>
definition extensional'
where "extensional' A \<equiv> {f. \<forall>x. x \<notin> A \<longrightarrow> f x = unity}"
abbreviation PiE'
where "PiE' A B \<equiv> Pi A B \<inter> extensional' A"
abbreviation restrict'
where "restrict' f A \<equiv> \<lambda>x. if x \<in> A then f x else unity"
lemma extensional'I [intro]:
assumes "\<And>x. x \<notin> A \<Longrightarrow> f x = unity"
shows "f \<in> extensional' A"
using assms extensional'_def by auto
lemma extensional'_arb:
assumes "f \<in> extensional' A"and"x \<notin> A"
shows "f x = unity"
using assms extensional'_def by fast
lemma extensional'_monotone:
assumes "A \<subseteq> B"
shows "extensional' A \<subseteq> extensional' B"
using assms extensional'_arb by fastforce
lemma PiE'_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> PiE' A B \<subseteq> PiE' A C"
by auto
end
locale discrete_diagram_in_set_category =
S: set_category S \<SS> +
discrete_diagram J S D +
diagram_in_set_category J S \<SS> D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and S :: "'s comp" (infixr \<open>\<cdot>\<close> 55) and \<SS> :: "'s set \<Rightarrow> bool" and D :: "'j \<Rightarrow> 's" begin
text\<open>
For @{term D} a discrete diagram in a set category, there is a bijective correspondence
between cones over @{term D} with apex unity and the setof extensional functions @{term d}
that map each arrow @{term j} of @{term[source=true] J} to an element of
@{term "S.set (D j)"}.
\<close>
abbreviation I
where "I \<equiv> Collect J.arr"
definition funToCone
where "funToCone F \<equiv> \<lambda>j. if J.arr j then S.mkPoint (D j) (F j) else S.null"
definition coneToFun
where "coneToFun \<chi> \<equiv> \<lambda>j. if J.arr j then S.img (\<chi> j) else S.unity"
lemma funToCone_mapsto:
shows "funToCone \<in> S.PiE' I (S.set o D) \<rightarrow> cones S.unity"
proof
fix F
assume F: "F \<in> S.PiE' I (S.set o D)"
interpret U: constant_functor J S S.unity
apply unfold_locales using S.ide_unity by auto
have "cone S.unity (funToCone F)"
proof
show "\<And>j. \<not>J.arr j \<Longrightarrow> funToCone F j = S.null"
using funToCone_def by simp
fix j
assume j: "J.arr j"
have "funToCone F j = S.mkPoint (D j) (F j)"
using j funToCone_def by simp
moreover have "... \<in> S.hom S.unity (D j)"
using F j is_discrete S.img_mkPoint(1) [of"D j"] by force
ultimately have 2: "funToCone F j \<in> S.hom S.unity (D j)" by auto
show "S.arr (funToCone F j)"
using 2 j by auto
show "D j \<cdot> funToCone F (J.dom j) = funToCone F j"
using 2 j is_discrete S.comp_cod_arr by auto
show "funToCone F (J.cod j) \<cdot> (U.map j) = funToCone F j"
using "2" S.comp_arr_dom is_discrete j by auto
qed
thus "funToCone F \<in> cones S.unity" by auto
qed
lemma coneToFun_mapsto:
shows "coneToFun \<in> cones S.unity \<rightarrow> S.PiE' I (S.set o D)"
proof
fix \<chi>
assume \<chi>: "\<chi> \<in> cones S.unity"
interpret \<chi>: cone J S D S.unity \<chi> using \<chi> by auto
show "coneToFun \<chi> \<in> S.PiE' I (S.set o D)"
proof
show "coneToFun \<chi> \<in> Pi I (S.set o D)"
using S.mkPoint_img(1) coneToFun_def is_discrete \<chi>.component_in_hom
by (simp add: S.img_point_elem_set restrict_apply')
show "coneToFun \<chi> \<in> S.extensional' I"
by (metis S.extensional'I coneToFun_def mem_Collect_eq)
qed
qed
lemma funToCone_coneToFun:
assumes "\<chi> \<in> cones S.unity"
shows "funToCone (coneToFun \<chi>) = \<chi>"
proof
interpret \<chi>: cone J S D S.unity \<chi> using assms by auto
fix j
have "\<not>J.arr j \<Longrightarrow> funToCone (coneToFun \<chi>) j = \<chi> j"
using funToCone_def \<chi>.extensionality by simp
moreover have "J.arr j \<Longrightarrow> funToCone (coneToFun \<chi>) j = \<chi> j"
using funToCone_def coneToFun_def S.mkPoint_img(2) is_discrete \<chi>.component_in_hom
by auto
ultimately show "funToCone (coneToFun \<chi>) j = \<chi> j" by blast
qed
lemma coneToFun_funToCone:
assumes "F \<in> S.PiE' I (S.set o D)"
shows "coneToFun (funToCone F) = F"
proof
fix i
have "i \<notin> I \<Longrightarrow> coneToFun (funToCone F) i = F i"
using assms coneToFun_def S.extensional'_arb [of F I i] by auto
moreover have "i \<in> I \<Longrightarrow> coneToFun (funToCone F) i = F i"
proof -
assume i: "i \<in> I"
have "coneToFun (funToCone F) i = S.img (funToCone F i)"
using i coneToFun_def by simp
also have "... = S.img (S.mkPoint (D i) (F i))"
using i funToCone_def by auto
also have "... = F i"
using assms i is_discrete S.img_mkPoint(2) by force
finally show "coneToFun (funToCone F) i = F i" by auto
qed
ultimately show "coneToFun (funToCone F) i = F i" by auto
qed
lemma bij_coneToFun:
shows "bij_betw coneToFun (cones S.unity) (S.PiE' I (S.set o D))"
using coneToFun_mapsto funToCone_mapsto funToCone_coneToFun coneToFun_funToCone
bij_betwI
by blast
lemma bij_funToCone:
shows "bij_betw funToCone (S.PiE' I (S.set o D)) (cones S.unity)"
using coneToFun_mapsto funToCone_mapsto funToCone_coneToFun coneToFun_funToCone
bij_betwI
by blast
end
context set_category begin
text\<open>
A set category admits @{term I}-indexed tupling if there is an injective map that takes
each extensional function from @{term I} to @{term Univ} to an element of @{term Univ}.
\<close>
definition admits_tupling
where "admits_tupling I \<equiv> \<exists>\<pi>. \<pi> \<in> PiE' I (\<lambda>_. Univ) \<rightarrow> Univ \<and> inj_on \<pi> (PiE' I (\<lambda>_. Univ))"
lemma admits_tupling_monotone:
assumes "admits_tupling I"and"I' \<subseteq> I"
shows "admits_tupling I'"
proof -
from assms(1) obtain \<pi>
where \<pi>: "\<pi> \<in> PiE' I (\<lambda>_. Univ) \<rightarrow> Univ \<and> inj_on \<pi> (PiE' I (\<lambda>_. Univ))"
using admits_tupling_def by metis
have "\<pi> \<in> PiE' I' (\<lambda>_. Univ) \<rightarrow> Univ"
proof
fix f
assume f: "f \<in> PiE' I' (\<lambda>_. Univ)"
have "f \<in> PiE' I (\<lambda>_. Univ)"
using assms(2) f extensional'_def [of I'] terminal_unity\<^sub>S\<^sub>C extensional'_monotone by auto
thus "\<pi> f \<in> Univ" using \<pi> by auto
qed
moreover have "inj_on \<pi> (PiE' I' (\<lambda>_. Univ))"
proof -
have 1: "\<And>F A A'. inj_on F A \<and> A' \<subseteq> A \<Longrightarrow> inj_on F A'"
using inj_on_subset by blast
moreover have "PiE' I' (\<lambda>_. Univ) \<subseteq> PiE' I (\<lambda>_. Univ)"
using assms(2) extensional'_def [of I'] terminal_unity\<^sub>S\<^sub>C by auto
ultimately show ?thesis using \<pi> assms(2) by blast
qed
ultimately show ?thesis using admits_tupling_def by metis
qed
lemma admits_tupling_respects_bij:
assumes "admits_tupling I"and"bij_betw \<phi> I I'"
shows "admits_tupling I'"
proof -
obtain \<pi> where \<pi>: "\<pi> \<in> (I \<rightarrow> Univ) \<inter> extensional' I \<rightarrow> Univ \<and>
inj_on \<pi> ((I \<rightarrow> Univ) \<inter> extensional' I)"
using assms(1) admits_tupling_def by metis
have inv: "bij_betw (inv_into I \<phi>) I' I"
using assms(2) bij_betw_inv_into by blast let ?C = "\<lambda>f x. if x \<in> I then f (\<phi> x) else unity" let ?\<pi>' = "\<lambda>f. \<pi> (?C f)"
have 1: "\<And>f. f \<in> (I' \<rightarrow> Univ) \<inter> extensional' I' \<Longrightarrow> ?C f \<in> (I \<rightarrow> Univ) \<inter> extensional' I"
using assms bij_betw_apply by fastforce
have "?\<pi>' \<in> (I' \<rightarrow> Univ) \<inter> extensional' I' \<rightarrow> Univ \<and>
inj_on ?\<pi>' ((I' \<rightarrow> Univ) \<inter> extensional' I')"
proof
show "(\<lambda>f. \<pi> (?C f)) \<in> (I' \<rightarrow> Univ) \<inter> extensional' I' \<rightarrow> Univ"
using 1 \<pi> by blast
show "inj_on ?\<pi>' ((I' \<rightarrow> Univ) \<inter> extensional' I')"
proof
fix f g
assume f: "f \<in> (I' \<rightarrow> Univ) \<inter> extensional' I'"
assume g: "g \<in> (I' \<rightarrow> Univ) \<inter> extensional' I'"
assume eq: "?\<pi>' f = ?\<pi>' g"
have f': "?C f \<in> (I \<rightarrow> Univ) \<inter> extensional' I"
using f 1 by simp
have g': "?C g \<in> (I \<rightarrow> Univ) \<inter> extensional' I"
using g 1 by simp
have 2: "?C f = ?C g"
using f' g' \<pi> eq by (simp add: inj_on_def)
show "f = g"
proof
fix x
show "f x = g x"
proof (cases "x \<in> I'")
show "x \<in> I' \<Longrightarrow> ?thesis"
using f g
by (metis (no_types, opaque_lifting) "2" assms(2) bij_betw_apply
bij_betw_inv_into_right inv)
show "x \<notin> I' \<Longrightarrow> ?thesis"
using f g by (metis IntD2 extensional'_arb)
qed
qed
qed
qed
thus ?thesis
using admits_tupling_def by blast
qed
end
context replete_set_category begin
lemma has_products_iff_admits_tupling:
fixes I :: "'i set"
shows "has_products I \<longleftrightarrow> I \<noteq> UNIV \<and> admits_tupling I"
proof
text\<open> If @{term[source=true] S} has @{term I}-indexed products, then for every @{term I}-indexed
discrete diagram @{term D} in @{term[source=true] S} there is an object @{term \<Pi>D} of @{term[source=true] S} whose points are in bijective correspondence with the setof
cones over @{term D} with apex @{term unity}. In particular this is true for
the diagram @{term D} that assigns to each element of @{term I} the
``universal object'' @{term "mkIde Univ"}.
\<close>
assume has_products: "has_products I"
have I: "I \<noteq> UNIV" using has_products has_products_def by auto
interpret J: discrete_category I \<open>SOME x. x \<notin> I\<close>
using I someI_ex [of"\<lambda>x. x \<notin> I"] by (unfold_locales, auto) let ?D = "\<lambda>i. mkIde Univ"
interpret D: discrete_diagram_from_map I S ?D \<open>SOME j. j \<notin> I\<close>
using J.not_arr_null J.arr_char ide_mkIde
by (unfold_locales, auto)
interpret D: discrete_diagram_in_set_category J.comp S \<open>\<lambda>A. A \<subseteq> Univ\<close> D.map ..
have "discrete_diagram J.comp S D.map" ..
from this obtain \<Pi>D \<chi> where \<chi>: "product_cone J.comp S D.map \<Pi>D \<chi>"
using has_products has_products_def [of I] has_productE [of"J.comp" D.map]
D.diagram_axioms
by (metis (mono_tags, lifting) J.arr_char mem_Collect_eq subsetI subset_antisym)
interpret \<chi>: product_cone J.comp S D.map \<Pi>D \<chi>
using \<chi> by auto
have "D.has_as_limit \<Pi>D"
using \<chi>.limit_cone_axioms by auto
hence \<Pi>D: "ide \<Pi>D \<and> (\<exists>\<phi>. bij_betw \<phi> (hom unity \<Pi>D) (D.cones unity))"
using D.limits_are_sets_of_cones by simp
from this obtain \<phi> where \<phi>: "bij_betw \<phi> (hom unity \<Pi>D) (D.cones unity)"
by blast
have \<phi>': "inv_into (hom unity \<Pi>D) \<phi> \<in> D.cones unity \<rightarrow> hom unity \<Pi>D \<and>
inj_on (inv_into (hom unity \<Pi>D) \<phi>) (D.cones unity)"
using \<phi> bij_betw_inv_into bij_betw_imp_inj_on bij_betw_imp_funcset by metis let ?\<pi> = "img o (inv_into (hom unity \<Pi>D) \<phi>) o D.funToCone"
have 1: "D.funToCone \<in> PiE' I (set o D.map) \<rightarrow> D.cones unity"
using D.funToCone_mapsto extensional'_def [of I] by auto
have 2: "inv_into (hom unity \<Pi>D) \<phi> \<in> D.cones unity \<rightarrow> hom unity \<Pi>D"
using \<phi>' by auto
have 3: "img \<in> hom unity \<Pi>D \<rightarrow> Univ"
using img_point_in_Univ by blast
have 4: "inj_on D.funToCone (PiE' I (set o D.map))"
proof -
have "D.I = I" by auto
thus ?thesis
using D.bij_funToCone bij_betw_imp_inj_on by auto
qed
have 5: "inj_on (inv_into (hom unity \<Pi>D) \<phi>) (D.cones unity)"
using \<phi>' by auto
have 6: "inj_on img (hom unity \<Pi>D)"
using \<Pi>D bij_betw_points_and_set bij_betw_imp_inj_on [of img "hom unity \<Pi>D""set \<Pi>D"]
by simp
have "?\<pi> \<in> PiE' I (set o D.map) \<rightarrow> Univ"
using 123 by force
moreover have "inj_on ?\<pi> (PiE' I (set o D.map))"
proof -
have 7: "\<And>A B C D F G H. F \<in> A \<rightarrow> B \<and> G \<in> B \<rightarrow> C \<and> H \<in> C \<rightarrow> D
\<and> inj_on F A \<and> inj_on G B \<and> inj_on H C
\<Longrightarrow> inj_on (H o G o F) A"
by (simp add: Pi_iff inj_on_def)
show ?thesis
using 1234567 [of D.funToCone "PiE' I (set o D.map)""D.cones unity" "inv_into (hom unity \<Pi>D) \<phi>""hom unity \<Pi>D"
img Univ]
by fastforce
qed
moreover have "PiE' I (set o D.map) = PiE' I (\<lambda>x. Univ)"
proof -
have "\<And>i. i \<in> I \<Longrightarrow> (set o D.map) i = Univ"
using J.arr_char D.map_def by simp
thus ?thesis by blast
qed
ultimately have "?\<pi> \<in> (PiE' I (\<lambda>x. Univ)) \<rightarrow> Univ \<and> inj_on ?\<pi> (PiE' I (\<lambda>x. Univ))"
by auto
thus "I \<noteq> UNIV \<and> admits_tupling I"
using I admits_tupling_def by auto
next
assume ex_\<pi>: "I \<noteq> UNIV \<and> admits_tupling I"
show "has_products I"
proof (unfold has_products_def)
from ex_\<pi> obtain \<pi>
where \<pi>: "\<pi> \<in> (PiE' I (\<lambda>x. Univ)) \<rightarrow> Univ \<and> inj_on \<pi> (PiE' I (\<lambda>x. Univ))"
using admits_tupling_def by metis
text\<open>
Given an @{term I}-indexed discrete diagram @{term D}, obtain the object @{term \<Pi>D} of @{term[source=true] S} corresponding to the set @{term "\<pi> ` PiE I D"} ofall
@{term "\<pi> d"} where \<open>d \<in> d \<in> J \<rightarrow>\<^sub>E Univ\<close> and @{term "d i \<in> D i"}
for all @{term "i \<in> I"}.
The elements of @{term \<Pi>D} are in bijective correspondence with the setof cones
over @{term D}, hence @{term \<Pi>D} is a limit of @{term D}.
\<close>
have "\<And>J D. discrete_diagram J S D \<and> Collect (partial_composition.arr J) = I
\<Longrightarrow> \<exists>\<Pi>D. has_as_product J D \<Pi>D"
proof
fix J :: "'i comp"and D
assume D: "discrete_diagram J S D \<and> Collect (partial_composition.arr J) = I"
interpret J: category J
using D discrete_diagram.axioms(1) by blast
interpret D: discrete_diagram J S D
using D by simp
interpret D: discrete_diagram_in_set_category J S \<open>\<lambda>A. A \<subseteq> Univ\<close> D .. let ?\<Pi>D = "mkIde (\<pi> ` PiE' I (set o D))"
have 0: "ide ?\<Pi>D"
proof -
have "set o D \<in> I \<rightarrow> Pow Univ"
using Pow_iff incl_in_def o_apply elem_set_implies_incl_in subsetI Pi_I'
setp_set_ide
by (metis (mono_tags, lifting))
hence "\<pi> ` PiE' I (set o D) \<subseteq> Univ"
using \<pi> by blast
thus ?thesis using \<pi> ide_mkIde by simp
qed
hence set_\<Pi>D: "\<pi> ` PiE' I (set o D) = set ?\<Pi>D"
using 0 ide_in_hom arr_mkIde set_mkIde by auto
text\<open>
The elements of @{term \<Pi>D} are all values of the form @{term "\<pi> d"},
where @{term d} satisfies @{term "d i \<in> set (D i)"} for all @{term "i \<in> I"}.
Such @{term d} correspond bijectively to cones.
Since @{term \<pi>} is injective, the values @{term "\<pi> d"} correspond bijectively to cones.
\<close> let ?\<phi> = "mkPoint ?\<Pi>D o \<pi> o D.coneToFun" let ?\<phi>' = "D.funToCone o inv_into (PiE' I (set o D)) \<pi> o img"
have 1: "\<pi> \<in> PiE' I (set o D) \<rightarrow> set ?\<Pi>D \<and> inj_on \<pi> (PiE' I (set o D))"
proof -
have "PiE' I (set o D) \<subseteq> PiE' I (\<lambda>x. Univ)"
using setp_set_ide elem_set_implies_incl_in elem_set_implies_set_eq_singleton
incl_in_def PiE'_mono comp_apply subsetI
by (metis (no_types, lifting))
thus ?thesis using \<pi> inj_on_subset set_\<Pi>D Pi_I' imageI by fastforce
qed
have 2: "inv_into (PiE' I (set o D)) \<pi> \<in> set ?\<Pi>D \<rightarrow> PiE' I (set o D)"
proof
fix y
assume y: "y \<in> set ?\<Pi>D"
have "y \<in> \<pi> ` (PiE' I (set o D))" using y set_\<Pi>D by auto
thus "inv_into (PiE' I (set o D)) \<pi> y \<in> PiE' I (set o D)"
using inv_into_into [of y \<pi> "PiE' I (set o D)"] by simp
qed
have 3: "\<And>x. x \<in> set ?\<Pi>D \<Longrightarrow> \<pi> (inv_into (PiE' I (set o D)) \<pi> x) = x"
using set_\<Pi>D by (simp add: f_inv_into_f)
have 4: "\<And>d. d \<in> PiE' I (set o D) \<Longrightarrow> inv_into (PiE' I (set o D)) \<pi> (\<pi> d) = d"
using 1 by auto
have 5: "D.I = I"
using D by auto
have "bij_betw ?\<phi> (D.cones unity) (hom unity ?\<Pi>D)"
proof (intro bij_betwI)
show "?\<phi> \<in> D.cones unity \<rightarrow> hom unity ?\<Pi>D"
proof
fix \<chi>
assume \<chi>: "\<chi> \<in> D.cones unity"
show "?\<phi> \<chi> \<in> hom unity ?\<Pi>D"
using \<chi> 015 D.coneToFun_mapsto mkPoint_in_hom [of ?\<Pi>D]
by (simp, blast)
qed
show "?\<phi>' \<in> hom unity ?\<Pi>D \<rightarrow> D.cones unity"
proof
fix x
assume x: "x \<in> hom unity ?\<Pi>D"
hence "img x \<in> set ?\<Pi>D"
using img_point_elem_set by blast
hence "inv_into (PiE' I (set o D)) \<pi> (img x) \<in> Pi I (set \<circ> D) \<inter> extensional' I"
using 2 by blast
thus "?\<phi>' x \<in> D.cones unity"
using 5 D.funToCone_mapsto by auto
qed
show "\<And>x. x \<in> hom unity ?\<Pi>D \<Longrightarrow> ?\<phi> (?\<phi>' x) = x"
proof -
fix x
assume x: "x \<in> hom unity ?\<Pi>D"
show "?\<phi> (?\<phi>' x) = x"
proof -
have "D.coneToFun (D.funToCone (inv_into (PiE' I (set o D)) \<pi> (img x)))
= inv_into (PiE' I (set o D)) \<pi> (img x)"
using x 15 img_point_elem_set set_\<Pi>D D.coneToFun_funToCone by force
hence "\<pi> (D.coneToFun (D.funToCone (inv_into (PiE' I (set o D)) \<pi> (img x))))
= img x"
using x 3 img_point_elem_set set_\<Pi>D by force
thus ?thesis using x 0 mkPoint_img by auto
qed
qed
show "\<And>\<chi>. \<chi> \<in> D.cones unity \<Longrightarrow> ?\<phi>' (?\<phi> \<chi>) = \<chi>"
proof -
fix \<chi>
assume \<chi>: "\<chi> \<in> D.cones unity"
show "?\<phi>' (?\<phi> \<chi>) = \<chi>"
proof -
have "img (mkPoint ?\<Pi>D (\<pi> (D.coneToFun \<chi>))) = \<pi> (D.coneToFun \<chi>)"
using \<chi> 015 D.coneToFun_mapsto img_mkPoint(2) by blast
hence "inv_into (PiE' I (set o D)) \<pi> (img (mkPoint ?\<Pi>D (\<pi> (D.coneToFun \<chi>))))
= D.coneToFun \<chi>"
using \<chi> D.coneToFun_mapsto 45
by (metis (no_types, lifting) PiE)
hence "D.funToCone (inv_into (PiE' I (set o D)) \<pi>
(img (mkPoint ?\<Pi>D (\<pi> (D.coneToFun \<chi>)))))
= \<chi>"
using \<chi> D.funToCone_coneToFun by auto
thus ?thesis by auto
qed
qed
qed
hence "bij_betw (inv_into (D.cones unity) ?\<phi>) (hom unity ?\<Pi>D) (D.cones unity)"
using bij_betw_inv_into by blast
hence "\<exists>\<phi>. bij_betw \<phi> (hom unity ?\<Pi>D) (D.cones unity)" by blast
hence "D.has_as_limit ?\<Pi>D"
using \<open>ide ?\<Pi>D\<close> D.limits_are_sets_of_cones by simp
from this obtain \<chi> where \<chi>: "limit_cone J S D ?\<Pi>D \<chi>" by blast
interpret \<chi>: limit_cone J S D ?\<Pi>D \<chi> using \<chi> by auto
interpret P: product_cone J S D ?\<Pi>D \<chi>
using \<chi> D.product_coneI by blast
have "product_cone J S D ?\<Pi>D \<chi>" ..
thus "has_as_product J D ?\<Pi>D"
using has_as_product_def by auto
qed
thus "I \<noteq> UNIV \<and>
(\<forall>J D. discrete_diagram J S D \<and> Collect (partial_composition.arr J) = I
\<longrightarrow> (\<exists>\<Pi>D. has_as_product J D \<Pi>D))"
using ex_\<pi> by blast
qed
qed
end
context replete_set_category begin
text\<open>
Characterization of the completeness properties enjoyed by a set category:
A set category @{term[source=true] S} has all limits at a type @{typ 'j}, ifand only if @{term[source=true] S} admits @{term I}-indexed tupling
for all @{typ 'j}-sets @{term I} such that @{term "I \<noteq> UNIV"}.
\<close>
theorem has_limits_iff_admits_tupling:
shows "has_limits (undefined :: 'j) \<longleftrightarrow> (\<forall>I :: 'j set. I \<noteq> UNIV \<longrightarrow> admits_tupling I)"
proof
assume has_limits: "has_limits (undefined :: 'j)"
show "\<forall>I :: 'j set. I \<noteq> UNIV \<longrightarrow> admits_tupling I"
using has_limits has_products_if_has_limits has_products_iff_admits_tupling by blast
next
assume admits_tupling: "\<forall>I :: 'j set. I \<noteq> UNIV \<longrightarrow> admits_tupling I"
show "has_limits (undefined :: 'j)"
using has_limits_def admits_tupling has_products_iff_admits_tupling
by (metis category.axioms(1) category.ideD(1) has_limits_if_has_products
iso_tuple_UNIV_I mem_Collect_eq partial_composition.not_arr_null)
qed
end
section "Limits in Functor Categories"
text\<open> In this section, we consider the special caseof limits in functor categories, with the objective of showing that limits in a functor category \<open>[A, B]\<close>
are given pointwise, and that \<open>[A, B]\<close> has all limits that @{term B} has.
\<close>
locale parametrized_diagram =
J: category J +
A: category A +
B: category B +
JxA: product_category J A +
binary_functor J A B D
for J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and A :: "'a comp" (infixr \<open>\<cdot>\<^sub>A\<close> 55) and B :: "'b comp" (infixr \<open>\<cdot>\<^sub>B\<close> 55) and D :: "'j * 'a \<Rightarrow> 'b" begin
(* Notation for A.in_hom and B.in_hom is being inherited, but from where? *)
notation J.in_hom (\<open>\<guillemotleft>_ : _ \<rightarrow>\<^sub>J _\<guillemotright>\<close>)
notation JxA.comp (infixr \<open>\<cdot>\<^sub>J\<^sub>x\<^sub>A\<close> 55)
notation JxA.in_hom (\<open>\<guillemotleft>_ : _ \<rightarrow>\<^sub>J\<^sub>x\<^sub>A _\<guillemotright>\<close>)
text\<open>
A choice of limit cone for each diagram \<open>D (-, a)\<close>, where @{term a}
is an object of @{term[source=true] A}, extends to a functor \<open>L: A \<rightarrow> B\<close>,
where the action of @{term L} on arrows of @{term[source=true] A} is determined by
universality.
\<close>
abbreviation L
where "L \<equiv> \<lambda>l \<chi>. \<lambda>a. if A.arr a then
limit_cone.induced_arrow J B (\<lambda>j. D (j, A.cod a))
(l (A.cod a)) (\<chi> (A.cod a))
(l (A.dom a)) (vertical_composite.map J B
(\<chi> (A.dom a)) (\<lambda>j. D (j, a))) else B.null"
abbreviation P
where "P \<equiv> \<lambda>l \<chi>. \<lambda>a f. \<guillemotleft>f : l (A.dom a) \<rightarrow>\<^sub>B l (A.cod a)\<guillemotright> \<and>
diagram.cones_map J B (\<lambda>j. D (j, A.cod a)) f (\<chi> (A.cod a)) =
vertical_composite.map J B (\<chi> (A.dom a)) (\<lambda>j. D (j, a))"
lemma L_arr:
assumes "\<forall>a. A.ide a \<longrightarrow> limit_cone J B (\<lambda>j. D (j, a)) (l a) (\<chi> a)"
shows "\<And>a. A.arr a \<Longrightarrow> (\<exists>!f. P l \<chi> a f) \<and> P l \<chi> a (L l \<chi> a)"
proof
fix a
assume a: "A.arr a"
interpret \<chi>_dom_a: limit_cone J B \<open>\<lambda>j. D (j, A.dom a)\<close> \<open>l (A.dom a)\<close> \<open>\<chi> (A.dom a)\<close>
using a assms by auto
interpret \<chi>_cod_a: limit_cone J B \<open>\<lambda>j. D (j, A.cod a)\<close> \<open>l (A.cod a)\<close> \<open>\<chi> (A.cod a)\<close>
using a assms by auto
interpret Da: natural_transformation J B \<open>\<lambda>j. D (j, A.dom a)\<close> \<open>\<lambda>j. D (j, A.cod a)\<close>
\<open>\<lambda>j. D (j, a)\<close>
using a fixing_arr_gives_natural_transformation_2 by simp
interpret Dao\<chi>_dom_a: vertical_composite J B
\<chi>_dom_a.A.map \<open>\<lambda>j. D (j, A.dom a)\<close> \<open>\<lambda>j. D (j, A.cod a)\<close>
\<open>\<chi> (A.dom a)\<close> \<open>\<lambda>j. D (j, a)\<close> ..
interpret Dao\<chi>_dom_a: cone J B \<open>\<lambda>j. D (j, A.cod a)\<close> \<open>l (A.dom a)\<close> Dao\<chi>_dom_a.map ..
show "P l \<chi> a (L l \<chi> a)"
using a Dao\<chi>_dom_a.cone_axioms \<chi>_cod_a.induced_arrowI [of Dao\<chi>_dom_a.map"l (A.dom a)"]
by auto
show "\<exists>!f. P l \<chi> a f"
using \<chi>_cod_a.is_universal Dao\<chi>_dom_a.cone_axioms by blast
qed
lemma L_ide:
assumes "\<forall>a. A.ide a \<longrightarrow> limit_cone J B (\<lambda>j. D (j, a)) (l a) (\<chi> a)"
shows "\<And>a. A.ide a \<Longrightarrow> L l \<chi> a = l a"
proof - let ?L = "L l \<chi>" let ?P = "P l \<chi>"
fix a
assume a: "A.ide a"
interpret \<chi>a: limit_cone J B \<open>\<lambda>j. D (j, a)\<close> \<open>l a\<close> \<open>\<chi> a\<close> using a assms by auto
have Pa: "?P a = (\<lambda>f. f \<in> B.hom (l a) (l a) \<and>
diagram.cones_map J B (\<lambda>j. D (j, a)) f (\<chi> a) = \<chi> a)"
using a vcomp_ide_dom \<chi>a.natural_transformation_axioms by simp
have "?P a (?L a)" using assms a L_arr [of l \<chi> a] by fastforce
moreover have "?P a (l a)"
proof -
have "?P a (l a) \<longleftrightarrow> l a \<in> B.hom (l a) (l a) \<and> \<chi>a.D.cones_map (l a) (\<chi> a) = \<chi> a"
using Pa by meson
thus ?thesis
using a \<chi>a.ide_apex \<chi>a.cone_axioms \<chi>a.D.cones_map_ide [of"\<chi> a""l a"] by force
qed
moreover have "\<exists>!f. ?P a f"
using a Pa \<chi>a.is_universal \<chi>a.cone_axioms by force
ultimately show "?L a = l a" by blast
qed
lemma chosen_limits_induce_functor:
assumes "\<forall>a. A.ide a \<longrightarrow> limit_cone J B (\<lambda>j. D (j, a)) (l a) (\<chi> a)"
shows "functor A B (L l \<chi>)"
proof - let ?L = "L l \<chi>" let ?P = "\<lambda>a. \<lambda>f. \<guillemotleft>f : l (A.dom a) \<rightarrow>\<^sub>B l (A.cod a)\<guillemotright> \<and>
diagram.cones_map J B (\<lambda>j. D (j, A.cod a)) f (\<chi> (A.cod a))
= vertical_composite.map J B (\<chi> (A.dom a)) (\<lambda>j. D (j, a))"
interpret L: "functor" A B ?L
apply unfold_locales
using assms L_arr [of l] L_ide
apply auto[4]
proof -
fix a' a
assume 1: "A.arr (A a' a)"
have a: "A.arr a" using 1 by auto
have a': "\<guillemotleft>a' : A.cod a \<rightarrow>\<^sub>A A.cod a'\<guillemotright>" using 1 by auto
have a'a: "A.seq a' a" using 1 by auto
interpret \<chi>_dom_a: limit_cone J B \<open>\<lambda>j. D (j, A.dom a)\<close> \<open>l (A.dom a)\<close> \<open>\<chi> (A.dom a)\<close>
using a assms by auto
interpret \<chi>_cod_a: limit_cone J B \<open>\<lambda>j. D (j, A.cod a)\<close> \<open>l (A.cod a)\<close> \<open>\<chi> (A.cod a)\<close>
using a'a assms by auto
interpret \<chi>_dom_a'a: limit_cone J B \<open>\<lambda>j. D (j, A.dom (a' \<cdot>\<^sub>A a))\<close> \<open>l (A.dom (a' \<cdot>\<^sub>A a))\<close>
\<open>\<chi> (A.dom (a' \<cdot>\<^sub>A a))\<close>
using a'a assms by auto
interpret \<chi>_cod_a'a: limit_cone J B \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close> \<open>l (A.cod (a' \<cdot>\<^sub>A a))\<close>
\<open>\<chi> (A.cod (a' \<cdot>\<^sub>A a))\<close>
using a'a assms by auto
interpret Da: natural_transformation J B
\<open>\<lambda>j. D (j, A.dom a)\<close> \<open>\<lambda>j. D (j, A.cod a)\<close> \<open>\<lambda>j. D (j, a)\<close>
using a fixing_arr_gives_natural_transformation_2 by simp
interpret Da': natural_transformation J B
\<open>\<lambda>j. D (j, A.cod a)\<close> \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close> \<open>\<lambda>j. D (j, a')\<close>
using a a'a fixing_arr_gives_natural_transformation_2 by fastforce
interpret Da'o\<chi>_cod_a: vertical_composite J B
\<chi>_cod_a.A.map \<open>\<lambda>j. D (j, A.cod a)\<close> \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close>
\<open>\<chi> (A.cod a)\<close> \<open>\<lambda>j. D (j, a')\<close>..
interpret Da'o\<chi>_cod_a: cone J B \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close> \<open>l (A.cod a)\<close> Da'o\<chi>_cod_a.map
..
interpret Da'a: natural_transformation J B
\<open>\<lambda>j. D (j, A.dom (a' \<cdot>\<^sub>A a))\<close> \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close>
\<open>\<lambda>j. D (j, a' \<cdot>\<^sub>A a)\<close>
using a'a fixing_arr_gives_natural_transformation_2 [of "a' \<cdot>\<^sub>A a"] by auto
interpret Da'ao\<chi>_dom_a'a:
vertical_composite J B \<chi>_dom_a'a.A.map \<open>\<lambda>j. D (j, A.dom (a' \<cdot>\<^sub>A a))\<close>
\<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close> \<open>\<chi> (A.dom (a' \<cdot>\<^sub>A a))\<close>
\<open>\<lambda>j. D (j, a' \<cdot>\<^sub>A a)\<close> ..
interpret Da'ao\<chi>_dom_a'a: cone J B \<open>\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))\<close>
\<open>l (A.dom (a' \<cdot>\<^sub>A a))\<close> Da'ao\<chi>_dom_a'a.map ..
show "?L (a' \<cdot>\<^sub>A a) = ?L a' \<cdot>\<^sub>B ?L a"
proof -
have "?P (a' \<cdot>\<^sub>A a) (?L (a' \<cdot>\<^sub>A a))" using assms a'a L_arr [of l \<chi> "a' \<cdot>\<^sub>A a"] by fastforce
moreover have "?P (a' \<cdot>\<^sub>A a) (?L a' \<cdot>\<^sub>B ?L a)"
proof
have La: "\<guillemotleft>?L a : l (A.dom a) \<rightarrow>\<^sub>B l (A.cod a)\<guillemotright>"
using assms a L_arr by fast
moreover have La': "\<guillemotleft>?L a' : l (A.cod a) \<rightarrow>\<^sub>B l (A.cod a')\<guillemotright>"
using assms a a' L_arr [of l \<chi> a'] by auto
ultimately have seq: "B.seq (?L a') (?L a)" by (elim B.in_homE, auto)
thus La'_La: "\<guillemotleft>?L a' \<cdot>\<^sub>B ?L a : l (A.dom (a' \<cdot>\<^sub>A a)) \<rightarrow>\<^sub>B l (A.cod (a' \<cdot>\<^sub>A a))\<guillemotright>"
using a a' 1 La La' by (intro B.comp_in_homI, auto)
show "\<chi>_cod_a'a.D.cones_map (?L a' \<cdot>\<^sub>B ?L a) (\<chi> (A.cod (a' \<cdot>\<^sub>A a)))
= Da'ao\<chi>_dom_a'a.map"
proof -
have "\<chi>_cod_a'a.D.cones_map (?L a' \<cdot>\<^sub>B ?L a) (\<chi> (A.cod (a' \<cdot>\<^sub>A a)))
= (\<chi>_cod_a'a.D.cones_map (?L a) o \<chi>_cod_a'a.D.cones_map (?L a'))
(\<chi> (A.cod a'))"
proof -
have "\<chi>_cod_a'a.D.cones_map (?L a' \<cdot>\<^sub>B ?L a) (\<chi> (A.cod (a' \<cdot>\<^sub>A a))) =
restrict (\<chi>_cod_a'a.D.cones_map (?L a) \<circ> \<chi>_cod_a'a.D.cones_map (?L a'))
(\<chi>_cod_a'a.D.cones (B.cod (?L a')))
(\<chi> (A.cod (a' \<cdot>\<^sub>A a)))"
using seq \<chi>_cod_a'a.cone_axioms \<chi>_cod_a'a.D.cones_map_comp [of"?L a'""?L a"]
by argo
also have "... = (\<chi>_cod_a'a.D.cones_map (?L a) o \<chi>_cod_a'a.D.cones_map (?L a'))
(\<chi> (A.cod a'))"
proof -
have "\<chi> (A.cod a') \<in> \<chi>_cod_a'a.D.cones (l (A.cod a'))"
using \<chi>_cod_a'a.cone_axioms a'a by simp
moreover have "B.cod (?L a') = l (A.cod a')"
using assms a' L_arr [of l] by auto
ultimately show ?thesis
using a' a'a by simp
qed
finally show ?thesis by blast
qed
also have "... = \<chi>_cod_a'a.D.cones_map (?L a)
(\<chi>_cod_a'a.D.cones_map (?L a') (\<chi> (A.cod a')))"
by simp
also have "... = \<chi>_cod_a'a.D.cones_map (?L a) Da'o\<chi>_cod_a.map"
proof -
have "?P a' (?L a')" using assms a' L_arr [of l \<chi> a'] by fast
moreover have "?P a' = (\<lambda>f. f \<in> B.hom (l (A.cod a)) (l (A.cod a')) \<and>
\<chi>_cod_a'a.D.cones_map f (\<chi> (A.cod a')) = Da'o\<chi>_cod_a.map)"
using a'a by force
ultimately show ?thesis using a'a by force
qed
also have "... = vertical_composite.map J B
(\<chi>_cod_a.D.cones_map (?L a) (\<chi> (A.cod a)))
(\<lambda>j. D (j, a'))"
using assms \<chi>_cod_a.D.diagram_axioms \<chi>_cod_a'a.D.diagram_axioms
Da'.natural_transformation_axioms \<chi>_cod_a.cone_axioms La
cones_map_vcomp [of J B "\<lambda>j. D (j, A.cod a)""\<lambda>j. D (j, A.cod (a' \<cdot>\<^sub>A a))" "\<lambda>j. D (j, a')""l (A.cod a)""\<chi> (A.cod a)" "?L a""l (A.dom a)"]
by blast
also have "... = vertical_composite.map J B
(vertical_composite.map J B (\<chi> (A.dom a)) (\<lambda>j. D (j, a)))
(\<lambda>j. D (j, a'))"
using assms a L_arr by presburger
also have "... = vertical_composite.map J B (\<chi> (A.dom a))
(vertical_composite.map J B (\<lambda>j. D (j, a)) (\<lambda>j. D (j, a')))"
using a'a Da.natural_transformation_axioms Da'.natural_transformation_axioms
\<chi>_dom_a.natural_transformation_axioms vcomp_assoc
by auto
also have "... = vertical_composite.map J B (\<chi> (A.dom (a' \<cdot>\<^sub>A a))) (\<lambda>j. D (j, a' \<cdot>\<^sub>A a))"
using a'a preserves_comp_2 by simp
finally show ?thesis by auto
qed
qed
moreover have "\<exists>!f. ?P (a' \<cdot>\<^sub>A a) f"
using \<chi>_cod_a'a.is_universal
[of"l (A.dom (a' \<cdot>\<^sub>A a))" "vertical_composite.map J B (\<chi> (A.dom (a' \<cdot>\<^sub>A a))) (\<lambda>j. D (j, a' \<cdot>\<^sub>A a))"]
Da'ao\<chi>_dom_a'a.cone_axioms
by fast
ultimately show ?thesis by blast
qed
qed
show ?thesis ..
qed
end
locale diagram_in_functor_category =
A: category A +
B: category B +
A_B: functor_category A B +
diagram J A_B.comp D
for A :: "'a comp" (infixr \<open>\<cdot>\<^sub>A\<close> 55) and B :: "'b comp" (infixr \<open>\<cdot>\<^sub>B\<close> 55) and J :: "'j comp" (infixr \<open>\<cdot>\<^sub>J\<close> 55) and D :: "'j \<Rightarrow> ('a, 'b) functor_category.arr" begin
interpretation JxA: product_category J A ..
interpretation A_BxA: product_category A_B.comp A ..
interpretation E: evaluation_functor A B ..
interpretation Curry: currying J A B ..
text\<open>
Evaluation of a functor or natural transformation from @{term[source=true] J}
to \<open>[A, B]\<close> at an arrow @{term a} of @{term[source=true] A}.
\<close>
abbreviation at
where "at a \<tau> \<equiv> \<lambda>j. Curry.uncurry \<tau> (j, a)"
lemma at_simp:
assumes "A.arr a"and"J.arr j"and"A_B.arr (\<tau> j)"
shows "at a \<tau> j = A_B.Map (\<tau> j) a"
using assms Curry.uncurry_def E.map_simp by simp
lemma functor_at_ide_is_functor:
assumes "functor J A_B.comp F"and"A.ide a"
shows "functor J B (at a F)"
proof -
interpret uncurry_F: "functor" JxA.comp B \<open>Curry.uncurry F\<close>
using assms(1) Curry.uncurry_preserves_functors by simp
interpret uncurry_F: binary_functor J A B \<open>Curry.uncurry F\<close> ..
show ?thesis using assms(2) uncurry_F.fixing_ide_gives_functor_2 by simp
qed
lemma functor_at_arr_is_transformation:
assumes "functor J A_B.comp F"and"A.arr a"
shows "natural_transformation J B (at (A.dom a) F) (at (A.cod a) F) (at a F)"
proof -
interpret uncurry_F: "functor" JxA.comp B \<open>Curry.uncurry F\<close>
using assms(1) Curry.uncurry_preserves_functors by simp
interpret uncurry_F: binary_functor J A B \<open>Curry.uncurry F\<close> ..
show ?thesis
using assms(2) uncurry_F.fixing_arr_gives_natural_transformation_2 by simp
qed
lemma transformation_at_ide_is_transformation:
assumes "natural_transformation J A_B.comp F G \<tau>"and"A.ide a"
shows "natural_transformation J B (at a F) (at a G) (at a \<tau>)"
proof -
interpret \<tau>: natural_transformation J A_B.comp F G \<tau> using assms(1) by auto
interpret uncurry_F: "functor" JxA.comp B \<open>Curry.uncurry F\<close>
using Curry.uncurry_preserves_functors \<tau>.F.functor_axioms by simp
interpret uncurry_f: binary_functor J A B \<open>Curry.uncurry F\<close> ..
interpret uncurry_G: "functor" JxA.comp B \<open>Curry.uncurry G\<close>
using Curry.uncurry_preserves_functors \<tau>.G.functor_axioms by simp
interpret uncurry_G: binary_functor J A B \<open>Curry.uncurry G\<close> ..
interpret uncurry_\<tau>: natural_transformation
JxA.comp B \<open>Curry.uncurry F\<close> \<open>Curry.uncurry G\<close> \<open>Curry.uncurry \<tau>\<close>
using Curry.uncurry_preserves_transformations \<tau>.natural_transformation_axioms
by simp
interpret uncurry_\<tau>: binary_functor_transformation J A B
\<open>Curry.uncurry F\<close> \<open>Curry.uncurry G\<close> \<open>Curry.uncurry \<tau>\<close> ..
show ?thesis
using assms(2) uncurry_\<tau>.fixing_ide_gives_natural_transformation_2 by simp
qed
lemma constant_at_ide_is_constant:
assumes "cone x \<chi>"and a: "A.ide a"
shows "at a (constant_functor.map J A_B.comp x) =
constant_functor.map J B (A_B.Map x a)"
proof -
interpret \<chi>: cone J A_B.comp D x \<chi> using assms(1) by auto
have x: "A_B.ide x" using \<chi>.ide_apex by auto
interpret Fun_x: "functor" A B \<open>A_B.Map x\<close>
using x A_B.ide_char by simp
interpret Da: "functor" J B \<open>at a D\<close>
using a functor_at_ide_is_functor functor_axioms by blast
interpret Da: diagram J B \<open>at a D\<close> ..
interpret Xa: constant_functor J B \<open>A_B.Map x a\<close>
using a Fun_x.preserves_ide by unfold_locales simp
show "at a \<chi>.A.map = Xa.map"
using a x Curry.uncurry_def E.map_def Xa.extensionality by auto
qed
lemma at_ide_is_diagram:
assumes a: "A.ide a"
shows "diagram J B (at a D)"
proof -
interpret Da: "functor" J B "at a D"
using a functor_at_ide_is_functor functor_axioms by simp
show ?thesis ..
qed
lemma cone_at_ide_is_cone:
assumes "cone x \<chi>"and a: "A.ide a"
shows "diagram.cone J B (at a D) (A_B.Map x a) (at a \<chi>)"
proof -
interpret \<chi>: cone J A_B.comp D x \<chi> using assms(1) by auto
have x: "A_B.ide x" using \<chi>.ide_apex by auto
interpret Fun_x: "functor" A B \<open>A_B.Map x\<close>
using x A_B.ide_char by simp
interpret Da: diagram J B \<open>at a D\<close> using a at_ide_is_diagram by auto
interpret Xa: constant_functor J B \<open>A_B.Map x a\<close>
using a by (unfold_locales, simp)
interpret \<chi>a: natural_transformation J B Xa.map \<open>at a D\<close> \<open>at a \<chi>\<close>
using assms(1) x a transformation_at_ide_is_transformation \<chi>.natural_transformation_axioms
constant_at_ide_is_constant
by fastforce
interpret \<chi>a: cone J B \<open>at a D\<close> \<open>A_B.Map x a\<close> \<open>at a \<chi>\<close> ..
show cone_\<chi>a: "Da.cone (A_B.Map x a) (at a \<chi>)" ..
qed
lemma at_preserves_comp:
assumes "A.seq a' a"
shows "at (A a' a) D = vertical_composite.map J B (at a D) (at a' D)"
proof -
interpret Da: natural_transformation J B \<open>at (A.dom a) D\<close> \<open>at (A.cod a) D\<close> \<open>at a D\<close>
using assms functor_at_arr_is_transformation functor_axioms by blast
interpret Da': natural_transformation J B \<open>at (A.cod a) D\<close> \<open>at (A.cod a') D\<close> \<open>at a' D\<close>
using assms functor_at_arr_is_transformation [of D a'] functor_axioms by fastforce
interpret Da'oDa: vertical_composite J B
\<open>at (A.dom a) D\<close> \<open>at (A.cod a) D\<close> \<open>at (A.cod a') D\<close>
\<open>at a D\<close> \<open>at a' D\<close> ..
interpret Da'a: natural_transformation J B \<open>at (A.dom a) D\<close> \<open>at (A.cod a') D\<close>
\<open>at (a' \<cdot>\<^sub>A a) D\<close>
using assms functor_at_arr_is_transformation [of D "a' \<cdot>\<^sub>A a"] functor_axioms by simp
show "at (a' \<cdot>\<^sub>A a) D = Da'oDa.map"
proof (intro natural_transformation_eqI)
show "natural_transformation J B (at (A.dom a) D) (at (A.cod a') D) Da'oDa.map" ..
show "natural_transformation J B (at (A.dom a) D) (at (A.cod a') D) (at (a' \<cdot>\<^sub>A a) D)" ..
show "\<And>j. J.ide j \<Longrightarrow> at (a' \<cdot>\<^sub>A a) D j = Da'oDa.map j"
proof -
fix j
assume j: "J.ide j"
interpret Dj: "functor" A B \<open>A_B.Map (D j)\<close>
using j preserves_ide A_B.ide_char by simp
show "at (a' \<cdot>\<^sub>A a) D j = Da'oDa.map j"
using assms j Dj.preserves_comp at_simp Da'oDa.map_simp_ide by auto
qed
qed
qed
lemma cones_map_pointwise:
assumes "cone x \<chi>"and"cone x' \<chi>'" and f: "f \<in> A_B.hom x' x"
shows "cones_map f \<chi> = \<chi>' \<longleftrightarrow>
(\<forall>a. A.ide a \<longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>')"
proof
interpret \<chi>: cone J A_B.comp D x \<chi> using assms(1) by auto
interpret \<chi>': cone J A_B.comp D x' \<chi>' using assms(2) by auto
have x: "A_B.ide x" using \<chi>.ide_apex by auto
have x': "A_B.ide x'" using \<chi>'.ide_apex by auto
interpret \<chi>f: cone J A_B.comp D x' \<open>cones_map f \<chi>\<close>
using x' f assms(1) cones_map_mapsto by blast
interpret Fun_x: "functor" A B \<open>A_B.Map x\<close> using x A_B.ide_char by simp
interpret Fun_x': "functor" A B \<open>A_B.Map x'\<close> using x' A_B.ide_char by simp
show "cones_map f \<chi> = \<chi>' \<Longrightarrow>
(\<forall>a. A.ide a \<longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>')"
proof -
assume \<chi>': "cones_map f \<chi> = \<chi>'"
have "\<And>a. A.ide a \<Longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>'"
proof -
fix a
assume a: "A.ide a"
interpret Da: diagram J B \<open>at a D\<close> using a at_ide_is_diagram by auto
interpret \<chi>a: cone J B \<open>at a D\<close> \<open>A_B.Map x a\<close> \<open>at a \<chi>\<close>
using a assms(1) cone_at_ide_is_cone by simp
interpret \<chi>'a: cone J B \<open>at a D\<close> \<open>A_B.Map x' a\<close> \<open>at a \<chi>'\<close>
using a assms(2) cone_at_ide_is_cone by simp
have 1: "\<guillemotleft>A_B.Map f a : A_B.Map x' a \<rightarrow>\<^sub>B A_B.Map x a\<guillemotright>"
using f a A_B.arr_char A_B.Map_cod A_B.Map_dom mem_Collect_eq
natural_transformation.preserves_hom A.ide_in_hom
by (metis (no_types, lifting) A_B.in_homE)
interpret \<chi>fa: cone J B \<open>at a D\<close> \<open>A_B.Map x' a\<close>
\<open>Da.cones_map (A_B.Map f a) (at a \<chi>)\<close>
using 1 \<chi>a.cone_axioms Da.cones_map_mapsto by force
show "Da.cones_map (A_B.Map f a) (at a \<chi>) = at a \<chi>'"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> Da.cones_map (A_B.Map f a) (at a \<chi>) j = at a \<chi>' j"
using \<chi>'a.extensionality \<chi>fa.extensionality [of j] by simp
moreover have "J.arr j \<Longrightarrow> Da.cones_map (A_B.Map f a) (at a \<chi>) j = at a \<chi>' j"
using a f 1 \<chi>.cone_axioms \<chi>a.cone_axioms at_simp
apply simp
apply (elim A_B.in_homE B.in_homE, auto)
using \<chi>' \<chi>.A.map_simp A_B.Map_comp [of "\<chi> j" f a a] by auto
ultimately show "Da.cones_map (A_B.Map f a) (at a \<chi>) j = at a \<chi>' j" by blast
qed
qed
thus "\<forall>a. A.ide a \<longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>'"
by simp
qed
show "\<forall>a. A.ide a \<longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>'
\<Longrightarrow> cones_map f \<chi> = \<chi>'"
proof -
assume A: "\<forall>a. A.ide a \<longrightarrow> diagram.cones_map J B (at a D) (A_B.Map f a) (at a \<chi>) = at a \<chi>'"
show "cones_map f \<chi> = \<chi>'"
proof (intro natural_transformation_eqI)
show "natural_transformation J A_B.comp \<chi>'.A.map D (cones_map f \<chi>)" ..
show "natural_transformation J A_B.comp \<chi>'.A.map D \<chi>'" ..
show "\<And>j. J.ide j \<Longrightarrow> cones_map f \<chi> j = \<chi>' j"
proof (intro A_B.arr_eqI)
fix j
assume j: "J.ide j"
show 1: "A_B.arr (cones_map f \<chi> j)"
using j \<chi>f.preserves_reflects_arr by simp
show "A_B.arr (\<chi>' j)" using j by auto
have Dom_\<chi>f_j: "A_B.Dom (cones_map f \<chi> j) = A_B.Map x'"
using x' j 1 A_B.Map_dom \<chi>'.A.map_simp \<chi>f.preserves_dom J.ide_in_hom
by (metis (no_types, lifting) J.ideD(2) \<chi>f.preserves_reflects_arr)
also have Dom_\<chi>'_j: "... = A_B.Dom (\<chi>' j)"
using x' j A_B.Map_dom [of "\<chi>' j"] \<chi>'.preserves_hom \<chi>'.A.map_simp by simp
finally show "A_B.Dom (cones_map f \<chi> j) = A_B.Dom (\<chi>' j)" by auto
have Cod_\<chi>f_j: "A_B.Cod (cones_map f \<chi> j) = A_B.Map (D (J.cod j))"
using j A_B.Map_cod A_B.cod_char J.ide_in_hom \<chi>f.preserves_hom
by (metis (no_types, lifting) "1" J.ideD(1) \<chi>f.preserves_cod)
also have Cod_\<chi>'_j: "... = A_B.Cod (\<chi>' j)"
using j A_B.Map_cod [of"\<chi>' j"] \<chi>'.preserves_hom by simp
finally show "A_B.Cod (cones_map f \<chi> j) = A_B.Cod (\<chi>' j)" by auto
show "A_B.Map (cones_map f \<chi> j) = A_B.Map (\<chi>' j)"
proof (intro natural_transformation_eqI)
interpret \<chi>fj: natural_transformation A B \<open>A_B.Map x'\<close> \<open>A_B.Map (D (J.cod j))\<close>
\<open>A_B.Map (cones_map f \<chi> j)\<close>
using j \<chi>f.preserves_reflects_arr A_B.arr_char [of"cones_map f \<chi> j"]
Dom_\<chi>f_j Cod_\<chi>f_j
by simp
show "natural_transformation A B (A_B.Map x') (A_B.Map (D (J.cod j)))
(A_B.Map (cones_map f \<chi> j))" ..
interpret \<chi>'j: natural_transformation A B \<open>A_B.Map x'\<close> \<open>A_B.Map (D (J.cod j))\<close>
\<open>A_B.Map (\<chi>' j)\<close>
using j A_B.arr_char [of"\<chi>' j"] Dom_\<chi>'_j Cod_\<chi>'_j by simp
show "natural_transformation A B (A_B.Map x') (A_B.Map (D (J.cod j)))
(A_B.Map (\<chi>' j))" ..
show "\<And>a. A.ide a \<Longrightarrow> A_B.Map (cones_map f \<chi> j) a = A_B.Map (\<chi>' j) a"
proof -
fix a
assume a: "A.ide a"
interpret Da: diagram J B \<open>at a D\<close> using a at_ide_is_diagram by auto
have cone_\<chi>a: "Da.cone (A_B.Map x a) (at a \<chi>)"
using a assms(1) cone_at_ide_is_cone by simp
interpret \<chi>a: cone J B \<open>at a D\<close> \<open>A_B.Map x a\<close> \<open>at a \<chi>\<close>
using cone_\<chi>a by auto
interpret Fun_f: natural_transformation A B \<open>A_B.Dom f\<close> \<open>A_B.Cod f\<close>
\<open>A_B.Map f\<close>
using f A_B.arr_char by fast
have fa: "A_B.Map f a \<in> B.hom (A_B.Map x' a) (A_B.Map x a)"
using a f Fun_f.preserves_hom A.ide_in_hom by auto
have "A_B.Map (cones_map f \<chi> j) a = Da.cones_map (A_B.Map f a) (at a \<chi>) j"
proof -
have "A_B.Map (cones_map f \<chi> j) a = A_B.Map (A_B.comp (\<chi> j) f) a"
using assms(1) f \<chi>.extensionality by auto
also have "... = B (A_B.Map (\<chi> j) a) (A_B.Map f a)"
using f j a \<chi>.preserves_hom A.ide_in_hom J.ide_in_hom A_B.Map_comp
\<chi>.A.map_simp
by (metis (no_types, lifting) A.comp_ide_self A.ideD(1) A_B.seqI'
J.ideD(1) mem_Collect_eq)
also have "... = Da.cones_map (A_B.Map f a) (at a \<chi>) j"
using j a cone_\<chi>a fa Curry.uncurry_def E.map_simp by auto
finally show ?thesis by auto
qed
also have "... = at a \<chi>' j" using j a A by simp
also have "... = A_B.Map (\<chi>' j) a"
using j Curry.uncurry_def E.map_simp \<chi>'j.extensionality by simp
finally show "A_B.Map (cones_map f \<chi> j) a = A_B.Map (\<chi>' j) a" by auto
qed
qed
qed
qed
qed
qed
text\<open> If @{term \<chi>} is a cone with apex @{term a} over @{term D}, then @{term \<chi>}
is a limit cone if, for each object @{term x} of @{term X}, the cone obtained
by evaluating @{term \<chi>} at @{term x} is a limit cone with apex @{term "A_B.Map a x"}
for the diagram in @{term C} obtained by evaluating @{term D} at @{term x}.
\<close>
lemma cone_is_limit_if_pointwise_limit:
assumes cone_\<chi>: "cone x \<chi>" and"\<forall>a. A.ide a \<longrightarrow> diagram.limit_cone J B (at a D) (A_B.Map x a) (at a \<chi>)"
shows "limit_cone x \<chi>"
proof -
interpret \<chi>: cone J A_B.comp D x \<chi> using assms by auto
have x: "A_B.ide x" using \<chi>.ide_apex by auto
show "limit_cone x \<chi>"
proof
fix x' \<chi>'
assume cone_\<chi>': "cone x' \<chi>'"
interpret \<chi>': cone J A_B.comp D x' \<chi>' using cone_\<chi>' by auto
have x': "A_B.ide x'" using \<chi>'.ide_apex by auto
text\<open>
The universality of the limit cone \<open>at a \<chi>\<close> yields, for each object
\<open>a\<close> of \<open>A\<close>, a unique arrow \<open>fa\<close> that transforms
\<open>at a \<chi>\<close> to \<open>at a \<chi>'\<close>.
\<close>
have EU: "\<And>a. A.ide a \<Longrightarrow>
\<exists>!fa. fa \<in> B.hom (A_B.Map x' a) (A_B.Map x a) \<and>
diagram.cones_map J B (at a D) fa (at a \<chi>) = at a \<chi>'"
proof -
fix a
assume a: "A.ide a"
interpret Da: diagram J B \<open>at a D\<close> using a at_ide_is_diagram by auto
interpret \<chi>a: limit_cone J B \<open>at a D\<close> \<open>A_B.Map x a\<close> \<open>at a \<chi>\<close>
using assms(2) a by auto
interpret \<chi>'a: cone J B \<open>at a D\<close> \<open>A_B.Map x' a\<close> \<open>at a \<chi>'\<close>
using a cone_\<chi>' cone_at_ide_is_cone by auto
have "Da.cone (A_B.Map x' a) (at a \<chi>')" ..
thus "\<exists>!fa. fa \<in> B.hom (A_B.Map x' a) (A_B.Map x a) \<and>
Da.cones_map fa (at a \<chi>) = at a \<chi>'"
using \<chi>a.is_universal by simp
qed
text\<open>
Our objective is to show the existence of a unique arrow \<open>f\<close> that transforms
\<open>\<chi>\<close> into \<open>\<chi>'\<close>. We obtain \<open>f\<close> by bundling the arrows \<open>fa\<close> of \<open>C\<close> and proving that this yields a natural transformation from \<open>X\<close>
to \<open>C\<close>, hence an arrow of \<open>[X, C]\<close>.
\<close>
show "\<exists>!f. \<guillemotleft>f : x' \<rightarrow>\<^sub>[\<^sub>A\<^sub>,\<^sub>B\<^sub>] x\<guillemotright> \<and> cones_map f \<chi> = \<chi>'"
proof let ?P = "\<lambda>a fa. \<guillemotleft>fa : A_B.Map x' a \<rightarrow>\<^sub>B A_B.Map x a\<guillemotright> \<and>
diagram.cones_map J B (at a D) fa (at a \<chi>) = at a \<chi>'"
have AaPa: "\<And>a. A.ide a \<Longrightarrow> ?P a (THE fa. ?P a fa)"
proof -
fix a
assume a: "A.ide a"
have "\<exists>!fa. ?P a fa" using a EU by simp
thus "?P a (THE fa. ?P a fa)" using a theI' [of "?P a"] by fastforce
qed
have AaPa_in_hom: "\<And>a. A.ide a \<Longrightarrow> \<guillemotleft>THE fa. ?P a fa : A_B.Map x' a \<rightarrow>\<^sub>B A_B.Map x a\<guillemotright>"
using AaPa by blast
have AaPa_map: "\<And>a. A.ide a \<Longrightarrow>
diagram.cones_map J B (at a D) (THE fa. ?P a fa) (at a \<chi>) = at a \<chi>'"
using AaPa by blast let ?Fun_f = "\<lambda>a. if A.ide a then (THE fa. ?P a fa) else B.null"
interpret Fun_x: "functor" A B \<open>\<lambda>a. A_B.Map x a\<close>
using x A_B.ide_char by simp
interpret Fun_x': "functor" A B \<open>\<lambda>a. A_B.Map x' a\<close>
using x' A_B.ide_char by simp
text\<open>
The arrows \<open>Fun_f a\<close> are the components of a natural transformation.
It is more work to verify the naturality than it seems like it ought to be.
\<close>
interpret \<phi>: transformation_by_components A B
\<open>\<lambda>a. A_B.Map x' a\<close> \<open>\<lambda>a. A_B.Map x a\<close> ?Fun_f
proof
fix a
assume a: "A.ide a"
show "\<guillemotleft>?Fun_f a : A_B.Map x' a \<rightarrow>\<^sub>B A_B.Map x a\<guillemotright>" using a AaPa by simp
next
fix a
assume a: "A.arr a"
text\<open>
\newcommand\xdom{\mathop{\rm dom}}
\newcommand\xcod{\mathop{\rm cod}}
$$\xymatrix{
{x_{\xdom a}} \drtwocell\omit{\omit(A)} \ar[d]_{\chi_{\xdom a}} \ar[r]^{x_a} & {x_{\xcod a}}
\ar[d]^{\chi_{\xcod a}} \\
{D_{\xdom a}} \ar[r]^{D_a} & {D_{\xcod a}} \\
{x'_{\xdom a}} \urtwocell\omit{\omit(B)} \ar@/^5em/[uu]^{f_{\xdom a}}_{\hspace{1em}(C)} \ar[u]^{\chi'_{\xdom a}}
\ar[r]_{x'_a} & {x'_{\xcod a}} \ar[u]_{x'_{\xcod a}} \ar@/_5em/[uu]_{f_{\xcod a}}
}$$
\<close> let ?x_dom_a = "A_B.Map x (A.dom a)" let ?x_cod_a = "A_B.Map x (A.cod a)" let ?x_a = "A_B.Map x a"
have x_a: "\<guillemotleft>?x_a : ?x_dom_a \<rightarrow>\<^sub>B ?x_cod_a\<guillemotright>"
using a x A_B.ide_char by auto let ?x'_dom_a = "A_B.Map x' (A.dom a)" let ?x'_cod_a = "A_B.Map x' (A.cod a)" let ?x'_a = "A_B.Map x' a"
have x'_a: "\<guillemotleft>?x'_a : ?x'_dom_a \<rightarrow>\<^sub>B ?x'_cod_a\<guillemotright>"
using a x' A_B.ide_char by auto let ?f_dom_a = "?Fun_f (A.dom a)" let ?f_cod_a = "?Fun_f (A.cod a)"
have f_dom_a: "\<guillemotleft>?f_dom_a : ?x'_dom_a \<rightarrow>\<^sub>B ?x_dom_a\<guillemotright>" using a AaPa by simp
have f_cod_a: "\<guillemotleft>?f_cod_a : ?x'_cod_a \<rightarrow>\<^sub>B ?x_cod_a\<guillemotright>" using a AaPa by simp
interpret D_dom_a: diagram J B \<open>at (A.dom a) D\<close> using a at_ide_is_diagram by simp
interpret D_cod_a: diagram J B \<open>at (A.cod a) D\<close> using a at_ide_is_diagram by simp
interpret Da: natural_transformation J B \<open>at (A.dom a) D\<close> \<open>at (A.cod a) D\<close> \<open>at a D\<close>
using a functor_axioms functor_at_arr_is_transformation by simp
interpret \<chi>_dom_a: limit_cone J B \<open>at (A.dom a) D\<close> \<open>A_B.Map x (A.dom a)\<close>
\<open>at (A.dom a) \<chi>\<close>
using assms(2) a by auto
interpret \<chi>_cod_a: limit_cone J B \<open>at (A.cod a) D\<close> \<open>A_B.Map x (A.cod a)\<close>
\<open>at (A.cod a) \<chi>\<close>
using assms(2) a by auto
interpret \<chi>'_dom_a: cone J B \<open>at (A.dom a) D\<close> \<open>A_B.Map x' (A.dom a)\<close>
\<open>at (A.dom a) \<chi>'\<close>
using a cone_\<chi>' cone_at_ide_is_cone by auto
interpret \<chi>'_cod_a: cone J B \<open>at (A.cod a) D\<close> \<open>A_B.Map x' (A.cod a)\<close>
\<open>at (A.cod a) \<chi>'\<close>
using a cone_\<chi>' cone_at_ide_is_cone by auto
text\<open>
Now construct cones with apexes \<open>x_dom_a\<close> and \<open>x'_dom_a\<close>
over @{term "at (A.cod a) D"} by forming the vertical composites of
@{term "at (A.dom a) \<chi>"} and @{term "at (A.cod a) \<chi>'"} with the natural
transformation @{term "at a D"}.
\<close>
interpret Dao\<chi>_dom_a: vertical_composite J B
\<chi>_dom_a.A.map \<open>at (A.dom a) D\<close> \<open>at (A.cod a) D\<close>
\<open>at (A.dom a) \<chi>\<close> \<open>at a D\<close> ..
interpret Dao\<chi>_dom_a: cone J B \<open>at (A.cod a) D\<close> ?x_dom_a Dao\<chi>_dom_a.map
using \<chi>_dom_a.cone_axioms Da.natural_transformation_axioms vcomp_transformation_cone
by metis
interpret Dao\<chi>'_dom_a: vertical_composite J B
\<chi>'_dom_a.A.map \<open>at (A.dom a) D\<close> \<open>at (A.cod a) D\<close>
\<open>at (A.dom a) \<chi>'\<close> \<open>at a D\<close> ..
interpret Dao\<chi>'_dom_a: cone J B \<open>at (A.cod a) D\<close> ?x'_dom_a Dao\<chi>'_dom_a.map
using \<chi>'_dom_a.cone_axioms Da.natural_transformation_axioms vcomp_transformation_cone
by metis
have Dao\<chi>_dom_a: "D_cod_a.cone ?x_dom_a Dao\<chi>_dom_a.map" ..
have Dao\<chi>'_dom_a: "D_cod_a.cone ?x'_dom_a Dao\<chi>'_dom_a.map" ..
text\<open>
These cones are also obtained by transforming the cones @{term "at (A.cod a) \<chi>"} and @{term "at (A.cod a) \<chi>'"} by \<open>x_a\<close> and \<open>x'_a\<close>, respectively.
\<close>
have A: "Dao\<chi>_dom_a.map = D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>)"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> Dao\<chi>_dom_a.map j = D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>) j"
using Dao\<chi>_dom_a.extensionality \<chi>_cod_a.cone_axioms x_a by force
moreover have "J.arr j \<Longrightarrow> Dao\<chi>_dom_a.map j = D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>) j"
proof -
assume j: "J.arr j"
have "Dao\<chi>_dom_a.map j = at a D j \<cdot>\<^sub>B at (A.dom a) \<chi> (J.dom j)"
using j Dao\<chi>_dom_a.map_simp_2 by simp
also have "... = A_B.Map (D j) a \<cdot>\<^sub>B A_B.Map (\<chi> (J.dom j)) (A.dom a)"
using a j at_simp by simp
also have "... = A_B.Map (A_B.comp (D j) (\<chi> (J.dom j))) a"
using a j A_B.Map_comp
by (metis (no_types, lifting) A.comp_arr_dom \<chi>.naturality1
\<chi>.preserves_reflects_arr)
also have "... = A_B.Map (A_B.comp (\<chi> (J.cod j)) (\<chi>.A.map j)) a"
using a j \<chi>.naturality by simp
also have "... = A_B.Map (\<chi> (J.cod j)) (A.cod a) \<cdot>\<^sub>B A_B.Map x a"
using a j x A_B.Map_comp
by (metis (no_types, lifting) A.comp_cod_arr \<chi>.A.map_simp \<chi>.naturality2
\<chi>.preserves_reflects_arr)
also have "... = at (A.cod a) \<chi> (J.cod j) \<cdot>\<^sub>B A_B.Map x a"
using a j at_simp by simp
also have "... = at (A.cod a) \<chi> j \<cdot>\<^sub>B A_B.Map x a"
using a j \<chi>_cod_a.naturality2 \<chi>_cod_a.A.map_simp
by (metis J.arr_cod_iff_arr J.cod_cod)
also have "... = D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>) j"
using a j x \<chi>_cod_a.cone_axioms preserves_cod by simp
finally show ?thesis by blast
qed
ultimately show "Dao\<chi>_dom_a.map j = D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>) j"
by blast
qed
have B: "Dao\<chi>'_dom_a.map = D_cod_a.cones_map ?x'_a (at (A.cod a) \<chi>')"
proof
fix j
have "\<not>J.arr j \<Longrightarrow>
Dao\<chi>'_dom_a.map j = D_cod_a.cones_map ?x'_a (at (A.cod a) \<chi>') j"
using Dao\<chi>'_dom_a.extensionality \<chi>'_cod_a.cone_axioms x'_a by force
moreover have "J.arr j \<Longrightarrow> Dao\<chi>'_dom_a.map j = D_cod_a.cones_map ?x'_a (at (A.cod a) \<chi>') j"
proof -
assume j: "J.arr j"
have "Dao\<chi>'_dom_a.map j = at a D j \<cdot>\<^sub>B at (A.dom a) \<chi>' (J.dom j)"
using j Dao\<chi>'_dom_a.map_simp_2 by simp
also have "... = A_B.Map (D j) a \<cdot>\<^sub>B A_B.Map (\<chi>' (J.dom j)) (A.dom a)"
using a j at_simp by simp
also have "... = A_B.Map (A_B.comp (D j) (\<chi>' (J.dom j))) a"
using a j A_B.Map_comp
by (metis (no_types, lifting) A.comp_arr_dom \<chi>'.naturality1
\<chi>'.preserves_reflects_arr)
also have "... = A_B.Map (A_B.comp (\<chi>' (J.cod j)) (\<chi>'.A.map j)) a"
using a j \<chi>'.naturality by simp
also have "... = A_B.Map (\<chi>' (J.cod j)) (A.cod a) \<cdot>\<^sub>B A_B.Map x' a"
using a j x' A_B.Map_comp
by (metis (no_types, lifting) A.comp_cod_arr \<chi>'.A.map_simp \<chi>'.naturality2
\<chi>'.preserves_reflects_arr)
also have "... = at (A.cod a) \<chi>' (J.cod j) \<cdot>\<^sub>B A_B.Map x' a"
using a j at_simp by simp
also have "... = at (A.cod a) \<chi>' j \<cdot>\<^sub>B A_B.Map x' a"
using a j \<chi>'_cod_a.naturality2 \<chi>'_cod_a.A.map_simp
by (metis J.arr_cod_iff_arr J.cod_cod)
also have "... = D_cod_a.cones_map ?x'_a (at (A.cod a) \<chi>') j"
using a j x' \<chi>'_cod_a.cone_axioms preserves_cod by simp
finally show ?thesis by blast
qed
ultimately show "Dao\<chi>'_dom_a.map j = D_cod_a.cones_map ?x'_a (at (A.cod a) \<chi>') j"
by blast
qed
text\<open>
Next, we show that \<open>f_dom_a\<close>, which is the unique arrow that transforms
\<open>\<chi>_dom_a\<close> into \<open>\<chi>'_dom_a\<close>, is also the unique arrow that transforms
\<open>Dao\<chi>_dom_a\<close> into \<open>Dao\<chi>'_dom_a\<close>.
\<close>
have C: "D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map = Dao\<chi>'_dom_a.map"
proof (intro natural_transformation_eqI)
show "natural_transformation
J B \<chi>'_dom_a.A.map (at (A.cod a) D) Dao\<chi>'_dom_a.map" ..
show "natural_transformation J B \<chi>'_dom_a.A.map (at (A.cod a) D)
(D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map)"
proof -
interpret \<kappa>: cone J B \<open>at (A.cod a) D\<close> ?x'_dom_a
\<open>D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map\<close>
proof -
have "\<And>b b' f. \<lbrakk> f \<in> B.hom b' b; D_cod_a.cone b Dao\<chi>_dom_a.map \<rbrakk>
\<Longrightarrow> D_cod_a.cone b' (D_cod_a.cones_map f Dao\<chi>_dom_a.map)"
using D_cod_a.cones_map_mapsto by blast
moreover have "D_cod_a.cone ?x_dom_a Dao\<chi>_dom_a.map" ..
ultimately show "D_cod_a.cone ?x'_dom_a
(D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map)"
using f_dom_a by simp
qed
show ?thesis ..
qed
show "\<And>j. J.ide j \<Longrightarrow>
D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map j = Dao\<chi>'_dom_a.map j"
proof -
fix j
assume j: "J.ide j"
have "D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map j =
Dao\<chi>_dom_a.map j \<cdot>\<^sub>B ?f_dom_a"
using j f_dom_a Dao\<chi>_dom_a.cone_axioms
by (elim B.in_homE, auto)
also have "... = (at a D j \<cdot>\<^sub>B at (A.dom a) \<chi> j) \<cdot>\<^sub>B ?f_dom_a"
using j Dao\<chi>_dom_a.map_simp_ide by simp
also have "... = at a D j \<cdot>\<^sub>B at (A.dom a) \<chi> j \<cdot>\<^sub>B ?f_dom_a"
using B.comp_assoc by simp
also have "... = at a D j \<cdot>\<^sub>B D_dom_a.cones_map ?f_dom_a (at (A.dom a) \<chi>) j"
using j \<chi>_dom_a.cone_axioms f_dom_a
by (elim B.in_homE, auto)
also have "... = at a D j \<cdot>\<^sub>B at (A.dom a) \<chi>' j"
using a AaPa A.ide_dom by presburger
also have "... = Dao\<chi>'_dom_a.map j"
using j Dao\<chi>'_dom_a.map_simp_ide by simp
finally show "D_cod_a.cones_map ?f_dom_a Dao\<chi>_dom_a.map j = Dao\<chi>'_dom_a.map j"
by auto
qed
qed
text\<open>
Naturality amounts to showing that \<open>C f_cod_a x'_a = C x_a f_dom_a\<close>.
To do this, we show that both arrows transform @{term "at (A.cod a) \<chi>"}
into \<open>Dao\<chi>'_cod_a\<close>, thus they are equal by the universality of
@{term "at (A.cod a) \<chi>"}.
\<close>
have "\<exists>!fa. \<guillemotleft>fa : ?x'_dom_a \<rightarrow>\<^sub>B ?x_cod_a\<guillemotright> \<and>
D_cod_a.cones_map fa (at (A.cod a) \<chi>) = Dao\<chi>'_dom_a.map"
using Dao\<chi>'_dom_a.cone_axioms a \<chi>_cod_a.is_universal [of ?x'_dom_a Dao\<chi>'_dom_a.map]
by fast
moreover have "?f_cod_a \<cdot>\<^sub>B ?x'_a \<in> B.hom ?x'_dom_a ?x_cod_a \<and>
D_cod_a.cones_map (?f_cod_a \<cdot>\<^sub>B ?x'_a) (at (A.cod a) \<chi>) = Dao\<chi>'_dom_a.map"
proof
show "?f_cod_a \<cdot>\<^sub>B ?x'_a \<in> B.hom ?x'_dom_a ?x_cod_a"
using f_cod_a x'_a by blast
show "D_cod_a.cones_map (?f_cod_a \<cdot>\<^sub>B ?x'_a) (at (A.cod a) \<chi>) = Dao\<chi>'_dom_a.map"
proof -
have "D_cod_a.cones_map (?f_cod_a \<cdot>\<^sub>B ?x'_a) (at (A.cod a) \<chi>)
= restrict (D_cod_a.cones_map ?x'_a o D_cod_a.cones_map ?f_cod_a)
(D_cod_a.cones (?x_cod_a))
(at (A.cod a) \<chi>)"
using x'_a D_cod_a.cones_map_comp [of ?f_cod_a ?x'_a] f_cod_a
by (elim B.in_homE, auto)
also have "... = D_cod_a.cones_map ?x'_a
(D_cod_a.cones_map ?f_cod_a (at (A.cod a) \<chi>))"
using \<chi>_cod_a.cone_axioms by simp
also have "... = Dao\<chi>'_dom_a.map"
using a B AaPa_map A.ide_cod by presburger
finally show ?thesis by auto
qed
qed
moreover have "?x_a \<cdot>\<^sub>B ?f_dom_a \<in> B.hom ?x'_dom_a ?x_cod_a \<and>
D_cod_a.cones_map (?x_a \<cdot>\<^sub>B ?f_dom_a) (at (A.cod a) \<chi>) = Dao\<chi>'_dom_a.map"
proof
show "?x_a \<cdot>\<^sub>B ?f_dom_a \<in> B.hom ?x'_dom_a ?x_cod_a"
using f_dom_a x_a by blast
show "D_cod_a.cones_map (?x_a \<cdot>\<^sub>B ?f_dom_a) (at (A.cod a) \<chi>) = Dao\<chi>'_dom_a.map"
proof -
have "D_cod_a.cones (B.cod (A_B.Map x a)) = D_cod_a.cones (A_B.Map x (A.cod a))"
using a x by simp
moreover have "B.seq ?x_a ?f_dom_a"
using f_dom_a x_a by (elim B.in_homE, auto)
ultimately have "D_cod_a.cones_map (?x_a \<cdot>\<^sub>B ?f_dom_a) (at (A.cod a) \<chi>)
= restrict (D_cod_a.cones_map ?f_dom_a o D_cod_a.cones_map ?x_a)
(D_cod_a.cones (?x_cod_a))
(at (A.cod a) \<chi>)"
using D_cod_a.cones_map_comp [of ?x_a ?f_dom_a] x_a by argo
also have "... = D_cod_a.cones_map ?f_dom_a
(D_cod_a.cones_map ?x_a (at (A.cod a) \<chi>))"
using \<chi>_cod_a.cone_axioms by simp
also have "... = Dao\<chi>'_dom_a.map"
using A C a AaPa by argo
finally show ?thesis by blast
qed
qed
ultimately show "?f_cod_a \<cdot>\<^sub>B ?x'_a = ?x_a \<cdot>\<^sub>B ?f_dom_a"
using a \<chi>_cod_a.is_universal by blast
qed
text\<open>
The arrow from @{term x'} to @{term x} in \<open>[A, B]\<close> determined by
the natural transformation \<open>\<phi>\<close> transforms @{term \<chi>} into @{term \<chi>'}.
Moreover, it is the unique such arrow, since the components of \<open>\<phi>\<close>
are each determined by universality.
\<close> let ?f = "A_B.MkArr (\<lambda>a. A_B.Map x' a) (\<lambda>a. A_B.Map x a) \<phi>.map"
have f_in_hom: "?f \<in> A_B.hom x' x"
proof -
have arr_f: "A_B.arr ?f"
using x' x A_B.arr_MkArr \<phi>.natural_transformation_axioms by simp
moreover have "A_B.MkIde (\<lambda>a. A_B.Map x a) = x"
using x A_B.ide_char A_B.MkArr_Map A_B.in_homE A_B.ide_in_hom by metis
moreover have "A_B.MkIde (\<lambda>a. A_B.Map x' a) = x'"
using x' A_B.ide_char A_B.MkArr_Map A_B.in_homE A_B.ide_in_hom by metis
ultimately show ?thesis
using A_B.dom_char A_B.cod_char by auto
qed
have Fun_f: "\<And>a. A.ide a \<Longrightarrow> A_B.Map ?f a = (THE fa. ?P a fa)"
using f_in_hom \<phi>.map_simp_ide by fastforce
have cones_map_f: "cones_map ?f \<chi> = \<chi>'"
using AaPa Fun_f at_ide_is_diagram assms(2) x x' cone_\<chi> cone_\<chi>' f_in_hom Fun_f
cones_map_pointwise
by presburger
show "\<guillemotleft>?f : x' \<rightarrow>\<^sub>[\<^sub>A\<^sub>,\<^sub>B\<^sub>] x\<guillemotright> \<and> cones_map ?f \<chi> = \<chi>'" using f_in_hom cones_map_f by auto
show "\<And>f'. \<guillemotleft>f' : x' \<rightarrow>\<^sub>[\<^sub>A\<^sub>,\<^sub>B\<^sub>] x\<guillemotright> \<and> cones_map f' \<chi> = \<chi>' \<Longrightarrow> f' = ?f"
proof -
fix f'
assume f': "\<guillemotleft>f' : x' \<rightarrow>\<^sub>[\<^sub>A\<^sub>,\<^sub>B\<^sub>] x\<guillemotright> \<and> cones_map f' \<chi> = \<chi>'"
have 0: "\<And>a. A.ide a \<Longrightarrow>
diagram.cones_map J B (at a D) (A_B.Map f' a) (at a \<chi>) = at a \<chi>'"
using f' cone_\<chi> cone_\<chi>' cones_map_pointwise by blast
have "f' = A_B.MkArr (A_B.Dom f') (A_B.Cod f') (A_B.Map f')"
using f' A_B.MkArr_Map by auto
also have "... = ?f"
proof (intro A_B.MkArr_eqI)
show 1: "A_B.Dom f' = A_B.Map x'" using f' A_B.Map_dom by auto
show 2: "A_B.Cod f' = A_B.Map x" using f' A_B.Map_cod by auto
show "A_B.Map f' = \<phi>.map"
proof (intro natural_transformation_eqI)
show "natural_transformation A B (A_B.Map x') (A_B.Map x) \<phi>.map" ..
show "natural_transformation A B (A_B.Map x') (A_B.Map x) (A_B.Map f')"
using f' 1 2 A_B.arr_char [of f'] by auto
show "\<And>a. A.ide a \<Longrightarrow> A_B.Map f' a = \<phi>.map a"
proof -
fix a
assume a: "A.ide a"
interpret Da: diagram J B \<open>at a D\<close> using a at_ide_is_diagram by auto
interpret Fun_f': natural_transformation A B \<open>A_B.Dom f'\<close> \<open>A_B.Cod f'\<close>
\<open>A_B.Map f'\<close>
using f' A_B.arr_char by fast
have "A_B.Map f' a \<in> B.hom (A_B.Map x' a) (A_B.Map x a)"
using a f' Fun_f'.preserves_hom A.ide_in_hom by auto
hence "?P a (A_B.Map f' a)" using a 0 [of a] by simp
moreover have "?P a (\<phi>.map a)"
using a \<phi>.map_simp_ide Fun_f AaPa by presburger
ultimately show "A_B.Map f' a = \<phi>.map a" using a EU by blast
qed
qed
qed
finally show "f' = ?f" by auto
qed
qed
qed
qed
end
context functor_category begin
text\<open>
A functor category \<open>[A, B]\<close> has limits of shape @{term[source=true] J}
whenever @{term B} has limits of shape @{term[source=true] J}.
\<close>
lemma has_limits_of_shape_if_target_does:
assumes "category (J :: 'j comp)" and"B.has_limits_of_shape J"
shows "has_limits_of_shape J"
proof (unfold has_limits_of_shape_def)
have "\<And>D. diagram J comp D \<Longrightarrow> (\<exists>x \<chi>. limit_cone J comp D x \<chi>)"
proof -
fix D
assume D: "diagram J comp D"
interpret J: category J using assms(1) by auto
interpret JxA: product_category J A ..
interpret D: diagram J comp D using D by auto
interpret D: diagram_in_functor_category A B J D ..
interpret Curry: currying J A B ..
text\<open>
Given diagram @{term D} in \<open>[A, B]\<close>, choose for each object \<open>a\<close> of \<open>A\<close> a limit cone \<open>(la, \<chi>a)\<close> for \<open>at a D\<close> in \<open>B\<close>.
\<close> let ?l = "\<lambda>a. diagram.some_limit J B (D.at a D)" let ?\<chi> = "\<lambda>a. diagram.some_limit_cone J B (D.at a D)"
have l\<chi>: "\<And>a. A.ide a \<Longrightarrow> diagram.limit_cone J B (D.at a D) (?l a) (?\<chi> a)"
using B.has_limits_of_shape_def D.at_ide_is_diagram assms(2)
diagram.limit_cone_some_limit_cone
by blast
text\<open>
The choice of limit cones induces a limit functor from \<open>A\<close> to \<open>B\<close>.
\<close>
interpret uncurry_D: diagram JxA.comp B "Curry.uncurry D"
proof -
interpret "functor" JxA.comp B \<open>Curry.uncurry D\<close>
using D.functor_axioms Curry.uncurry_preserves_functors by simp
interpret binary_functor J A B \<open>Curry.uncurry D\<close> ..
show "diagram JxA.comp B (Curry.uncurry D)" ..
qed
interpret uncurry_D: parametrized_diagram J A B \<open>Curry.uncurry D\<close> .. let ?L = "uncurry_D.L ?l ?\<chi>" let ?P = "uncurry_D.P ?l ?\<chi>"
interpret L: "functor" A B ?L
using l\<chi> uncurry_D.chosen_limits_induce_functor [of ?l ?\<chi>] by simp
have L_ide: "\<And>a. A.ide a \<Longrightarrow> ?L a = ?l a"
using uncurry_D.L_ide [of ?l ?\<chi>] l\<chi> by blast
have L_arr: "\<And>a. A.arr a \<Longrightarrow> (\<exists>!f. ?P a f) \<and> ?P a (?L a)"
using uncurry_D.L_arr [of ?l ?\<chi>] l\<chi> by blast
text\<open>
The functor \<open>L\<close> extends to a functor \<open>L'\<close> from \<open>JxA\<close>
to \<open>B\<close> that is constant on \<open>J\<close>.
\<close> let ?L' = "\<lambda>ja. if JxA.arr ja then ?L (snd ja) else B.null" let ?P' = "\<lambda>ja. ?P (snd ja)"
interpret L': "functor" JxA.comp B ?L'
apply unfold_locales
using L.preserves_arr L.preserves_dom L.preserves_cod
apply auto[4]
using L.preserves_comp JxA.comp_char by (elim JxA.seqE, auto)
have "\<And>ja. JxA.arr ja \<Longrightarrow> (\<exists>!f. ?P' ja f) \<and> ?P' ja (?L' ja)"
proof -
fix ja
assume ja: "JxA.arr ja"
have "A.arr (snd ja)" using ja by blast
thus "(\<exists>!f. ?P' ja f) \<and> ?P' ja (?L' ja)"
using ja L_arr by presburger
qed
hence L'_arr: "\<And>ja. JxA.arr ja \<Longrightarrow> ?P' ja (?L' ja)" by blast
have L'_ide: "\<And>ja. \<lbrakk> J.arr (fst ja); A.ide (snd ja) \<rbrakk> \<Longrightarrow> ?L' ja = ?l (snd ja)"
using L_ide l\<chi> by force
have L'_arr_map: "\<And>ja. JxA.arr ja \<Longrightarrow> uncurry_D.P ?l ?\<chi> (snd ja) (uncurry_D.L ?l ?\<chi> (snd ja))"
using L'_arr by presburger
text\<open>
The map that takes an object \<open>(j, a)\<close> of \<open>JxA\<close> to the component
\<open>\<chi> a j\<close> of the limit cone \<open>\<chi> a\<close> is a natural transformation
from \<open>L\<close> to uncurry \<open>D\<close>.
\<close> let ?\<chi>' = "\<lambda>ja. ?\<chi> (snd ja) (fst ja)"
interpret \<chi>': transformation_by_components JxA.comp B ?L' \<open>Curry.uncurry D\<close> ?\<chi>'
proof
fix ja
assume ja: "JxA.ide ja" let ?j = "fst ja" let ?a = "snd ja"
interpret \<chi>a: limit_cone J B \<open>D.at ?a D\<close> \<open>?l ?a\<close> \<open>?\<chi> ?a\<close>
using ja l\<chi> by blast
show "\<guillemotleft>?\<chi>' ja : ?L' ja \<rightarrow>\<^sub>B Curry.uncurry D ja\<guillemotright>"
using ja L'_ide [of ja] by force
next
fix ja
assume ja: "JxA.arr ja" let ?j = "fst ja" let ?a = "snd ja"
have j: "J.arr ?j" using ja by simp
have a: "A.arr ?a" using ja by simp
interpret D_dom_a: diagram J B \<open>D.at (A.dom ?a) D\<close>
using a D.at_ide_is_diagram by auto
interpret D_cod_a: diagram J B \<open>D.at (A.cod ?a) D\<close>
using a D.at_ide_is_diagram by auto
interpret Da: natural_transformation J B
\<open>D.at (A.dom ?a) D\<close> \<open>D.at (A.cod ?a) D\<close> \<open>D.at ?a D\<close>
using a D.functor_axioms D.functor_at_arr_is_transformation by simp
interpret \<chi>_dom_a: limit_cone J B \<open>D.at (A.dom ?a) D\<close> \<open>?l (A.dom ?a)\<close>
\<open>?\<chi> (A.dom ?a)\<close>
using a l\<chi> by simp
interpret \<chi>_cod_a: limit_cone J B \<open>D.at (A.cod ?a) D\<close> \<open>?l (A.cod ?a)\<close>
\<open>?\<chi> (A.cod ?a)\<close>
using a l\<chi> by simp
interpret Dao\<chi>_dom_a: vertical_composite J B
\<chi>_dom_a.A.map \<open>D.at (A.dom ?a) D\<close> \<open>D.at (A.cod ?a) D\<close>
\<open>?\<chi> (A.dom ?a)\<close> \<open>D.at ?a D\<close>
..
interpret Dao\<chi>_dom_a: cone J B \<open>D.at (A.cod ?a) D\<close> \<open>?l (A.dom ?a)\<close> Dao\<chi>_dom_a.map ..
show "?\<chi>' (JxA.cod ja) \<cdot>\<^sub>B ?L' ja = B (Curry.uncurry D ja) (?\<chi>' (JxA.dom ja))"
proof -
have "?\<chi>' (JxA.cod ja) \<cdot>\<^sub>B ?L' ja = ?\<chi> (A.cod ?a) (J.cod ?j) \<cdot>\<^sub>B ?L' ja"
using ja by fastforce
also have "... = D_cod_a.cones_map (?L' ja) (?\<chi> (A.cod ?a)) (J.cod ?j)"
using ja L'_arr_map [of ja] \<chi>_cod_a.cone_axioms by auto
also have "... = Dao\<chi>_dom_a.map (J.cod ?j)"
using ja \<chi>_cod_a.induced_arrowI Dao\<chi>_dom_a.cone_axioms L'_arr by presburger
also have "... = D.at ?a D (J.cod ?j) \<cdot>\<^sub>B D_dom_a.some_limit_cone (J.cod ?j)"
using ja Dao\<chi>_dom_a.map_simp_ide by fastforce
also have "... = D.at ?a D (J.cod ?j) \<cdot>\<^sub>B D.at (A.dom ?a) D ?j \<cdot>\<^sub>B ?\<chi>' (JxA.dom ja)"
using ja \<chi>_dom_a.naturality \<chi>_dom_a.ide_apex apply simp
by (metis B.comp_arr_ide \<chi>_dom_a.preserves_reflects_arr)
also have "... = (D.at ?a D (J.cod ?j) \<cdot>\<^sub>B D.at (A.dom ?a) D ?j) \<cdot>\<^sub>B ?\<chi>' (JxA.dom ja)"
using j ja B.comp_assoc by presburger
also have "... = B (D.at ?a D ?j) (?\<chi>' (JxA.dom ja))"
using a j ja Map_comp A.comp_arr_dom D.as_nat_trans.naturality2 by simp
also have "... = Curry.uncurry D ja \<cdot>\<^sub>B ?\<chi>' (JxA.dom ja)"
using Curry.uncurry_def by simp
finally show ?thesis by auto
qed
qed
text\<open>
Since \<open>\<chi>'\<close> is constant on \<open>J\<close>, \<open>curry \<chi>'\<close> is a cone over \<open>D\<close>.
\<close>
interpret constL: constant_functor J comp \<open>MkIde ?L\<close>
using L.as_nat_trans.natural_transformation_axioms MkArr_in_hom ide_in_hom
L.functor_axioms
by unfold_locales blast (* TODO: This seems a little too involved. *)
have curry_L': "constL.map = Curry.curry ?L' ?L' ?L'"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> constL.map j = Curry.curry ?L' ?L' ?L' j"
using Curry.curry_def constL.extensionality by simp
moreover have "J.arr j \<Longrightarrow> constL.map j = Curry.curry ?L' ?L' ?L' j"
using Curry.curry_def constL.value_is_ide in_homE ide_in_hom by auto
ultimately show "constL.map j = Curry.curry ?L' ?L' ?L' j" by blast
qed
hence uncurry_constL: "Curry.uncurry constL.map = ?L'"
using L'.as_nat_trans.natural_transformation_axioms Curry.uncurry_curry by simp
interpret curry_\<chi>': natural_transformation J comp constL.map D
\<open>Curry.curry ?L' (Curry.uncurry D) \<chi>'.map\<close>
proof -
have "Curry.curry (Curry.uncurry D) (Curry.uncurry D) (Curry.uncurry D) = D"
using Curry.curry_uncurry D.functor_axioms D.as_nat_trans.natural_transformation_axioms
by blast
thus "natural_transformation J comp constL.map D
(Curry.curry ?L' (Curry.uncurry D) \<chi>'.map)"
using Curry.curry_preserves_transformations curry_L' \<chi>'.natural_transformation_axioms
by force
qed
interpret curry_\<chi>': cone J comp D \<open>MkIde ?L\<close> \<open>Curry.curry ?L' (Curry.uncurry D) \<chi>'.map\<close>
..
text\<open>
The value of \<open>curry_\<chi>'\<close> at each object \<open>a\<close> of \<open>A\<close> is the
limit cone \<open>\<chi> a\<close>, hence \<open>curry_\<chi>'\<close> is a limit cone.
\<close>
have 1: "\<And>a. A.ide a \<Longrightarrow> D.at a (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map) = ?\<chi> a"
proof -
fix a
assume a: "A.ide a"
have "D.at a (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map) =
(\<lambda>j. Curry.uncurry (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map) (j, a))"
using a by simp
moreover have "... = (\<lambda>j. \<chi>'.map (j, a))"
using a Curry.uncurry_curry \<chi>'.natural_transformation_axioms by simp
moreover have "... = ?\<chi> a"
proof (intro natural_transformation_eqI)
interpret \<chi>a: limit_cone J B \<open>D.at a D\<close> \<open>?l a\<close> \<open>?\<chi> a\<close> using a l\<chi> by simp
interpret \<chi>': binary_functor_transformation J A B ?L' \<open>Curry.uncurry D\<close> \<chi>'.map ..
show "natural_transformation J B \<chi>a.A.map (D.at a D) (?\<chi> a)" ..
show "natural_transformation J B \<chi>a.A.map (D.at a D) (\<lambda>j. \<chi>'.map (j, a))"
proof -
have "\<chi>a.A.map = (\<lambda>j. ?L' (j, a))"
using a \<chi>a.A.map_def L'_ide by auto
thus ?thesis
using a \<chi>'.fixing_ide_gives_natural_transformation_2 by simp
qed
fix j
assume j: "J.ide j"
show "\<chi>'.map (j, a) = ?\<chi> a j"
using a j \<chi>'.map_simp_ide by simp
qed
ultimately show "D.at a (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map) = ?\<chi> a" by simp
qed
hence 2: "\<And>a. A.ide a \<Longrightarrow> diagram.limit_cone J B (D.at a D) (?l a)
(D.at a (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map))"
using l\<chi> by simp
hence "limit_cone J comp D (MkIde ?L) (Curry.curry ?L' (Curry.uncurry D) \<chi>'.map)"
using 12 L.functor_axioms L_ide curry_\<chi>'.cone_axioms curry_L'
D.cone_is_limit_if_pointwise_limit
by simp
thus "\<exists>x \<chi>. limit_cone J comp D x \<chi>" by blast
qed
thus "\<forall>D. diagram J comp D \<longrightarrow> (\<exists>x \<chi>. limit_cone J comp D x \<chi>)" by blast
qed
lemma has_limits_if_target_does:
assumes "B.has_limits (undefined :: 'j)"
shows "has_limits (undefined :: 'j)"
using assms B.has_limits_def has_limits_def has_limits_of_shape_if_target_does by fast
end
section "The Yoneda Functor Preserves Limits"
text\<open> In this section, we show that the Yoneda functor from \<open>C\<close> to \<open>[Cop, S]\<close>
preserves limits.
\<close>
context yoneda_functor begin
lemma preserves_limits:
fixes J :: "'j comp"
assumes "diagram J C D"and"diagram.has_as_limit J C D a"
shows "diagram.has_as_limit J Cop_S.comp (map o D) (map a)"
proof -
text\<open>
The basic idea of the proof is as follows: If \<open>\<chi>\<close> is a limit cone in \<open>C\<close>, then for every object \<open>a'\<close> of \<open>Cop\<close> the evaluation of \<open>Y o \<chi>\<close> at \<open>a'\<close> is a limit cone in \<open>S\<close>. By the results on limits in functor categories,
this implies that \<open>Y o \<chi>\<close> is a limit cone in \<open>[Cop, S]\<close>.
\<close>
interpret J: category J using assms(1) diagram_def by auto
interpret D: diagram J C D using assms(1) by auto
from assms(2) obtain \<chi> where \<chi>: "D.limit_cone a \<chi>" by blast
interpret \<chi>: limit_cone J C D a \<chi> using \<chi> by auto
have a: "C.ide a" using \<chi>.ide_apex by auto
interpret YoD: diagram J Cop_S.comp \<open>map o D\<close>
using D.diagram_axioms functor_axioms preserves_diagrams [of J D] by simp
interpret YoD: diagram_in_functor_category Cop.comp S J \<open>map o D\<close> ..
interpret Yo\<chi>: cone J Cop_S.comp \<open>map o D\<close> \<open>map a\<close> \<open>map o \<chi>\<close>
using \<chi>.cone_axioms preserves_cones by blast
have "\<And>a'. C.ide a' \<Longrightarrow>
limit_cone J S (YoD.at a' (map o D))
(Cop_S.Map (map a) a') (YoD.at a' (map o \<chi>))"
proof -
fix a'
assume a': "C.ide a'"
interpret A': constant_functor J C a'
using a' by (unfold_locales, auto)
interpret YoD_a': diagram J S \<open>YoD.at a' (map o D)\<close>
using a' YoD.at_ide_is_diagram by simp
interpret Yo\<chi>_a': cone J S \<open>YoD.at a' (map o D)\<close>
\<open>Cop_S.Map (map a) a'\<close> \<open>YoD.at a' (map o \<chi>)\<close>
using a' YoD.cone_at_ide_is_cone Yo\<chi>.cone_axioms by fastforce
have eval_at_ide: "\<And>j. J.ide j \<Longrightarrow> YoD.at a' (map \<circ> D) j = Hom.map (a', D j)"
proof -
fix j
assume j: "J.ide j"
have "YoD.at a' (map \<circ> D) j = Cop_S.Map (map (D j)) a'"
using a' j YoD.at_simp YoD.preserves_arr [of j] by auto
also have "... = Y (D j) a'" using Y_def by simp
also have "... = Hom.map (a', D j)" using a' j D.preserves_arr by simp
finally show "YoD.at a' (map \<circ> D) j = Hom.map (a', D j)" by auto
qed
have eval_at_arr: "\<And>j. J.arr j \<Longrightarrow> YoD.at a' (map \<circ> \<chi>) j = Hom.map (a', \<chi> j)"
proof -
fix j
assume j: "J.arr j"
have "YoD.at a' (map \<circ> \<chi>) j = Cop_S.Map ((map o \<chi>) j) a'"
using a' j YoD.at_simp [of a' j "map o \<chi>"] preserves_arr by fastforce
also have "... = Y (\<chi> j) a'" using Y_def by simp
also have "... = Hom.map (a', \<chi> j)" using a' j by simp
finally show "YoD.at a' (map \<circ> \<chi>) j = Hom.map (a', \<chi> j)" by auto
qed
have Fun_map_a_a': "Cop_S.Map (map a) a' = Hom.map (a', a)"
using a a' map_simp preserves_arr [of a] by simp
show "limit_cone J S (YoD.at a' (map o D))
(Cop_S.Map (map a) a') (YoD.at a' (map o \<chi>))"
proof
fix x \<sigma>
assume \<sigma>: "YoD_a'.cone x \<sigma>"
interpret \<sigma>: cone J S \<open>YoD.at a' (map o D)\<close> x \<sigma> using \<sigma> by auto
have x: "S.ide x" using \<sigma>.ide_apex by simp
text\<open>
For each object \<open>j\<close> of \<open>J\<close>, the component \<open>\<sigma> j\<close>
is an arrow in \<open>S.hom x (Hom.map (a', D j))\<close>.
Each element \<open>e \<in> S.set x\<close> therefore determines an arrow
\<open>\<psi> (a', D j) (S.Fun (\<sigma> j) e) \<in> C.hom a' (D j)\<close>.
These arrows are the components of a cone \<open>\<kappa> e\<close> over @{term D} with apex @{term a'}.
\<close>
have \<sigma>j: "\<And>j. J.ide j \<Longrightarrow> \<guillemotleft>\<sigma> j : x \<rightarrow>\<^sub>S Hom.map (a', D j)\<guillemotright>"
using eval_at_ide \<sigma>.preserves_hom J.ide_in_hom by force
have \<kappa>: "\<And>e. e \<in> S.set x \<Longrightarrow>
transformation_by_components
J C A'.map D (\<lambda>j. \<psi> (a', D j) (S.Fun (\<sigma> j) e))"
proof -
fix e
assume e: "e \<in> S.set x"
show "transformation_by_components J C A'.map D (\<lambda>j. \<psi> (a', D j) (S.Fun (\<sigma> j) e))"
proof
fix j
assume j: "J.ide j"
show "\<guillemotleft>\<psi> (a', D j) (S.Fun (\<sigma> j) e) : A'.map j \<rightarrow> D j\<guillemotright>"
using e j S.Fun_mapsto [of"\<sigma> j"] A'.preserves_ide Hom.set_map eval_at_ide
Hom.\<psi>_mapsto [of"A'.map j""D j"]
by force
next
fix j
assume j: "J.arr j"
show "\<psi> (a', D (J.cod j)) (S.Fun (\<sigma> (J.cod j)) e) \<cdot> A'.map j =
D j \<cdot> \<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e)"
proof -
have "\<psi> (a', D (J.cod j)) (S.Fun (\<sigma> (J.cod j)) e) \<cdot> A'.map j =
\<psi> (a', D (J.cod j)) (S.Fun (\<sigma> (J.cod j)) e) \<cdot> a'"
using A'.map_simp j by simp
also have "... = \<psi> (a', D (J.cod j)) (S.Fun (\<sigma> (J.cod j)) e)"
proof -
have "\<psi> (a', D (J.cod j)) (S.Fun (\<sigma> (J.cod j)) e) \<in> C.hom a' (D (J.cod j))"
using a' e j Hom.\<psi>_mapsto [of "A'.map j" "D (J.cod j)"] A'.map_simp
S.Fun_mapsto [of"\<sigma> (J.cod j)"] Hom.set_map eval_at_ide
by auto
thus ?thesis
using C.comp_arr_dom by fastforce
qed
also have "... = \<psi> (a', D (J.cod j)) (S.Fun (Y (D j) a') (S.Fun (\<sigma> (J.dom j)) e))"
proof -
have "S.Fun (Y (D j) a') (S.Fun (\<sigma> (J.dom j)) e) =
(S.Fun (Y (D j) a') o S.Fun (\<sigma> (J.dom j))) e"
by simp
also have "... = S.Fun (Y (D j) a' \<cdot>\<^sub>S \<sigma> (J.dom j)) e"
using a' e j Y_arr_ide(1) S.in_homE \<sigma>j eval_at_ide S.Fun_comp by force
also have "... = S.Fun (\<sigma> (J.cod j)) e"
using a' j x \<sigma>.naturality2 \<sigma>.A.map_simp S.comp_arr_dom J.arr_cod_iff_arr
J.cod_cod YoD.preserves_arr \<sigma>.naturality1 YoD.at_simp
by auto
finally have "S.Fun (Y (D j) a') (S.Fun (\<sigma> (J.dom j)) e) = S.Fun (\<sigma> (J.cod j)) e"
by auto
thus ?thesis by simp
qed
also have "... = D j \<cdot> \<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e)"
proof -
have "S.Fun (Y (D j) a') (S.Fun (\<sigma> (J.dom j)) e) =
\<phi> (a', D (J.cod j)) (D j \<cdot> \<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e))"
proof -
have "S.Fun (\<sigma> (J.dom j)) e \<in> Hom.set (a', D (J.dom j))"
using a' e j \<sigma>j S.Fun_mapsto [of "\<sigma> (J.dom j)"] Hom.set_map
YoD.at_simp eval_at_ide
by auto
moreover have "C.arr (\<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e)) \<and>
C.dom (\<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e)) = a'"
using a' e j \<sigma>j S.Fun_mapsto [of "\<sigma> (J.dom j)"] Hom.set_map eval_at_ide
Hom.\<psi>_mapsto [of a' "D (J.dom j)"]
by auto
ultimately show ?thesis
using a' e j Hom.Fun_map C.comp_arr_dom by force
qed
moreover have "D j \<cdot> \<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e)
\<in> C.hom a' (D (J.cod j))"
proof -
have "\<psi> (a', D (J.dom j)) (S.Fun (\<sigma> (J.dom j)) e) \<in> C.hom a' (D (J.dom j))"
using a' e j Hom.\<psi>_mapsto [of a'"D (J.dom j)"] eval_at_ide
S.Fun_mapsto [of"\<sigma> (J.dom j)"] Hom.set_map
by auto
thus ?thesis using j D.preserves_hom by blast
qed
ultimately show ?thesis using a' j Hom.\<psi>_\<phi> by simp
qed
finally show ?thesis by auto
qed
qed
qed let ?\<kappa> = "\<lambda>e. transformation_by_components.map J C A'.map
(\<lambda>j. \<psi> (a', D j) (S.Fun (\<sigma> j) e))"
have cone_\<kappa>e: "\<And>e. e \<in> S.set x \<Longrightarrow> D.cone a' (?\<kappa> e)"
proof -
fix e
assume e: "e \<in> S.set x"
interpret \<kappa>e: transformation_by_components J C A'.map D
\<open>\<lambda>j. \<psi> (a', D j) (S.Fun (\<sigma> j) e)\<close>
using e \<kappa> by blast
show "D.cone a' (?\<kappa> e)" ..
qed
text\<open>
Since \<open>\<kappa> e\<close> is a cone for each element \<open>e\<close> of \<open>S.set x\<close>,
by the universal property of the limit cone \<open>\<chi>\<close> there is a unique arrow
\<open>fe \<in> C.hom a' a\<close> that transforms \<open>\<chi>\<close> to \<open>\<kappa> e\<close>.
\<close>
have ex_fe: "\<And>e. e \<in> S.set x \<Longrightarrow> \<exists>!fe. \<guillemotleft>fe : a' \<rightarrow> a\<guillemotright> \<and> D.cones_map fe \<chi> = ?\<kappa> e"
using cone_\<kappa>e \<chi>.is_universal by simp
text\<open>
The map taking \<open>e \<in> S.set x\<close> to \<open>fe \<in> C.hom a' a\<close>
determines an arrow \<open>f \<in> S.hom x (Hom (a', a))\<close> that
transforms the cone obtained by evaluating \<open>Y o \<chi>\<close> at \<open>a'\<close>
to the cone \<open>\<sigma>\<close>.
\<close> let ?f = "S.mkArr (S.set x) (Hom.set (a', a))
(\<lambda>e. \<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e)))"
have 0: "(\<lambda>e. \<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e))) \<in> S.set x \<rightarrow> Hom.set (a', a)"
proof
fix e
assume e: "e \<in> S.set x"
interpret \<kappa>e: cone J C D a' \<open>?\<kappa> e\<close> using e cone_\<kappa>e by simp
have "\<chi>.induced_arrow a' (?\<kappa> e) \<in> C.hom a' a"
using a a' e ex_fe \<chi>.induced_arrowI \<kappa>e.cone_axioms by simp
thus "\<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e)) \<in> Hom.set (a', a)"
using a a' Hom.\<phi>_mapsto by auto
qed
have f: "\<guillemotleft>?f : x \<rightarrow>\<^sub>S Hom.map (a', a)\<guillemotright>"
proof -
have "(\<lambda>e. \<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e))) \<in> S.set x \<rightarrow> Hom.set (a', a)"
proof
fix e
assume e: "e \<in> S.set x"
interpret \<kappa>e: cone J C D a' \<open>?\<kappa> e\<close> using e cone_\<kappa>e by simp
have "\<chi>.induced_arrow a' (?\<kappa> e) \<in> C.hom a' a"
using a a' e ex_fe \<chi>.induced_arrowI \<kappa>e.cone_axioms by simp
thus "\<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e)) \<in> Hom.set (a', a)"
using a a' Hom.\<phi>_mapsto by auto
qed
moreover have "setp (Hom.set (a', a))"
using a a' Hom.small_homs
by (metis Fun_map_a_a' Hom.map_ide S.arr_mkIde S.ideD(1) Yo\<chi>_a'.ide_apex)
ultimately show ?thesis
using a a' x \<sigma>.ide_apex S.mkArr_in_hom [of "S.set x" "Hom.set (a', a)"]
Hom.set_subset_Univ S.mkIde_set
by simp
qed
have "YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)) = \<sigma>"
proof (intro natural_transformation_eqI)
show "natural_transformation J S \<sigma>.A.map (YoD.at a' (map o D)) \<sigma>"
using \<sigma>.natural_transformation_axioms by auto
have 1: "S.cod ?f = Cop_S.Map (map a) a'"
using f Fun_map_a_a' by force
interpret YoD_a'of: cone J S \<open>YoD.at a' (map o D)\<close> x
\<open>YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>))\<close>
proof -
have "YoD_a'.cone (S.cod ?f) (YoD.at a' (map o \<chi>))"
using a a' f Yo\<chi>_a'.cone_axioms preserves_arr [of a] by auto
hence "YoD_a'.cone (S.dom ?f) (YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)))"
using f YoD_a'.cones_map_mapsto S.arrI by blast
thus "cone J S (YoD.at a' (map o D)) x
(YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)))"
using f by auto
qed
show "natural_transformation J S \<sigma>.A.map (YoD.at a' (map o D))
(YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)))" ..
fix j
assume j: "J.ide j"
have "YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)) j = YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f"
using f j Fun_map_a_a' Yo\<chi>_a'.cone_axioms by fastforce
also have "... = \<sigma> j"
proof (intro S.arr_eqI\<^sub>S\<^sub>C)
show "S.par (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) (\<sigma> j)"
using 1 f j x YoD_a'.preserves_hom by fastforce
show "S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) = S.Fun (\<sigma> j)"
proof
fix e
have "e \<notin> S.set x \<Longrightarrow> S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e = S.Fun (\<sigma> j) e"
using 1 f j x S.Fun_mapsto [of"\<sigma> j"] \<sigma>.A.map_simp
extensional_arb [of"S.Fun (\<sigma> j)"]
by auto
moreover have "e \<in> S.set x \<Longrightarrow>
S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e = S.Fun (\<sigma> j) e"
proof -
assume e: "e \<in> S.set x"
interpret \<kappa>e: transformation_by_components J C A'.map D
\<open>\<lambda>j. \<psi> (a', D j) (S.Fun (\<sigma> j) e)\<close>
using e \<kappa> by blast
interpret \<kappa>e: cone J C D a' \<open>?\<kappa> e\<close> using e cone_\<kappa>e by simp
have induced_arrow: "\<chi>.induced_arrow a' (?\<kappa> e) \<in> C.hom a' a"
using a a' e ex_fe \<chi>.induced_arrowI \<kappa>e.cone_axioms by simp
have "S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e =
restrict (S.Fun (YoD.at a' (map o \<chi>) j) o S.Fun ?f) (S.set x) e"
using 1 e f j S.Fun_comp YoD_a'.preserves_hom by force
pop_head:. >.java.lang.StringIndexOutOfBoundsException: Index 46 out of bounds for length 46
using j a' f e Hom.map_simp_2 S.Fun_mkArr Hom.preserves_arr [of "(a', \<chi> j)"]
by (elim S.in_homE, auto st:: _ = java.lang.StringIndexOutOfBoundsException: Index 19 out of bounds for length 19
also have "... = (\<phi> (a', D j) o C (\<chi> j) o \<psi> (a', a))
(\<phi> (a', a) (\<chi>.induced_arrow a' (?\<kappa> e)))"
using e f S.Fun_mkArr by fastforce
also have "... = \<phi> (a', D j) (D.cones_map (\<chi>.induced_arrow a' (?\<kappa> e)) \<chi> j)"
using a a' e j 0 Hom.\<psi>_\<phi> induced_arrow \<chi>.cone_axioms by auto
also have "... = \<phi> (a', D j) (?\<kappa> e j)"
using \<chi>.induced_arrowI \<kappa>e.cone_axioms by fastforce
also have "... = \<phi> (a', D j) (\<psi> (a', D j) (S.Fun (\<sigma> j) e))"
using j \<kappa>e.map_def [of j] by simp
also have "... = S.Fun (\<sigma> j) e"
proof -
have "S.Fun (\<sigma> j) e \<in> Hom.set (a', D j)"
using a' e j S.Fun_mapsto [of "\<sigma> j"] eval_at_ide Hom.set_map by auto
thus ?thesis
using a' j Hom.\<phi>_\<psi> C.ide_in_hom J.ide_in_hom by blast
qed
finally show "S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e = S.Fun (\<sigma> j) e"
by auto
qed
ultimately show "S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e = S.Fun (\<sigma> j) e"
by auto
qed
qed
finally show "YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)) j = \<sigma> j" by auto
qed
hence ff: "?f \<in> S.hom x (Hom.map (a', a)) \<and>
YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)) = \<sigma>"
using f by auto
text\<open>
Any other arrow \<open>f' \<in> S.hom x (Hom.map (a', a))\<close> that
transforms the cone obtained by evaluating \<open>Y o \<chi>\<close> at @{term a'}
to the cone @{term \<sigma>}, must equal \<open>f\<close>, showing that \<open>f\<close>
is unique.
\<close>
moreover have "\<And>f'. \<guillemotleft>f' : x \<rightarrow>\<^sub>S Hom.map (a', a)\<guillemotright> \<and>
YoD_a'.cones_map f' (YoD.at a' (map o \<chi>)) = \<sigma>
\<Longrightarrow> f' = ?f"
proof -
fix f'
assume f': "\<guillemotleft>f' : x \<rightarrow>\<^sub>S Hom.map (a', a)\<guillemotright> \<and>
YoD_a'.cones_map f' (YoD.at a' (map o \<chi>)) = \<sigma>"
show "f' = ?f"
proof (intro S.arr_eqI\<^sub>S\<^sub>C)
show par: "S.par f' ?f" using f f' by (elim S.in_homE, auto)
show "S.Fun f' = S.Fun ?f"
proof
fix e
have "e \<notin> S.set x \<Longrightarrow> S.Fun f' e = S.Fun ?f e"
using f f' S.Fun_in_terms_of_comp by fastforce
moreover have "e \<in> S.set x \<Longrightarrow> S.Fun f' e = S.Fun ?f e"
proof -
assume e: "e \<in> S.set x"
have fe: "S.Fun ?f e \<in> Hom.set (a', a)"
using e f par by auto
have f'e: "S.Fun f' e \<in> Hom.set (a', a)"
using a a' e f' S.Fun_mapsto Hom.set_map by fastforce
have 1: "\<guillemotleft>\<psi> (a', a) (S.Fun f' e) : a' \<rightarrow> a\<guillemotright>"
using a a' e f' f'e S.Fun_mapsto Hom.\<psi>_mapsto Hom.set_map by blast
have 2: "\<guillemotleft>\<psi> (a', a) (S.Fun ?f e) : a' \<rightarrow> a\<guillemotright>"
using a a' e f' fe S.Fun_mapsto Hom.\<psi>_mapsto Hom.set_map by blast
interpret \<chi>ofe: cone J C D a' \<open>D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi>\<close>
proof -
have "D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<in> D.cones a \<rightarrow> D.cones a'"
using 2 D.cones_map_mapsto [of"\<psi> (a', a) (S.Fun ?f e)"]
by (elim C.in_homE, auto)
thus "cone J C D a' (D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi>)"
using \<chi>.cone_axioms by blast
qed
have A: "\<And>h j. h \<in> C.hom a' a \<Longrightarrow> J.arr j \<Longrightarrow>
S.Fun (YoD.at a' (map o \<chi>) j) (\<phi> (a', a) h)
= \<phi> (a', D (J.cod j)) (\<chi> j \<cdot> h)"
proof -
fix h j
assume j: "J.arr j"
assume h: "h \<in> C.hom a' a"
have "S.Fun (YoD.at a' (map o \<chi>) j) (\<phi> (a', a) h)
= (\<phi> (a', D (J.cod j)) \<circ> C (\<chi> j) \<circ> \<psi> (a', a)) (\<phi> (a', a) h)"
proof -
have "S.Fun (YoD.at a' (map o \<chi>) j)
= restrict (\<phi> (a', D (J.cod j)) \<circ> C (\<chi> j) \<circ> \<psi> (a', a))
(Hom.set (a', a))"
proof -
have "S.Fun (YoD.at a' (map o \<chi>) j) = S.Fun (Y (\<chi> j) a')"
using a' j YoD.at_simp Y_def Yo\<chi>.preserves_reflects_arr [of j]
by simp
also have "... = restrict (\<phi> (a', D (J.cod j)) \<circ> C (\<chi> j) \<circ> \<psi> (a', a))
(Hom.set (a', a))"
using a' j \<chi>.preserves_hom [of j "J.dom j" "J.cod j"]
Y_arr_ide [of a' "\<chi> j" a "D (J.cod j)"] \<chi>.A.map_simp S.Fun_mkArr
by fastforce
finally show ?thesis by blast
qed
thus ?thesis
using a a' h Hom.\<phi>_mapsto by auto
qed
also have "... = \<phi> (a', D (J.cod j)) (\<chi> j \<cdot> h)"
using a a' h Hom.\<psi>_\<phi> by simp
finally show "S.Fun (YoD.at a' (map o \<chi>) j) (\<phi> (a', a) h)
= \<phi> (a', D (J.cod j)) (\<chi> j \<cdot> h)"
by auto
qed
have "D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> =
D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi>"
proof
fix j
have "\<not>J.arr j \<Longrightarrow> D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> j =
D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi> j"
using 12 \<chi>.cone_axioms by (elim C.in_homE, auto)
moreover have "J.arr j \<Longrightarrow> D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> j =
D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi> j"
proof -
assume j: "J.arr j"
have "D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> j =
\<chi> j \<cdot> \<psi> (a', a) (S.Fun f' e)"
using j 1 \<chi>.cone_axioms by auto
also have "... = \<psi> (a', D (J.cod j)) (S.Fun (\<sigma> j) e)"
proof -
have "\<psi> (a', D (J.cod j)) (S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun f' e)) =
\<psi> (a', D (J.cod j))
(\<phi> (a', D (J.cod j)) (\<chi> j \<cdot> \<psi> (a', a) (S.Fun f' e)))"
using j a a' f'e A Hom.\<phi>_\<psi> Hom.\<psi>_mapsto by force
moreover have "\<chi> j \<cdot> \<psi> (a', a) (S.Fun f' e) \<in> C.hom a' (D (J.cod j))"
using a a' j f'e Hom.\<psi>_mapsto \<chi>.preserves_hom [of j "J.dom j""J.cod j"]
\<chi>.A.map_simp
by auto
moreover have "S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun f' e) =
S.Fun (\<sigma> j) e"
using Fun_map_a_a' a a' j f' e x Yo\<chi>_a'.A.map_simp eval_at_ide
Yo\<chi>_a'.cone_axioms
by auto
ultimately show ?thesis
using a a' Hom.\<psi>_\<phi> by auto
qed
also have "... = \<chi> j \<cdot> \<psi> (a', a) (S.Fun ?f e)"
proof -
have "S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun ?f e) =
\<phi> (a', D (J.cod j)) (\<chi> j \<cdot> \<psi> (a', a) (S.Fun ?f e))"
using j a a' fe A [of "\<psi> (a', a) (S.Fun ?f e)" j] Hom.\<phi>_\<psi> Hom.\<psi>_mapsto
by auto
hence "\<psi> (a', D (J.cod j)) (S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun ?f e)) =
\<psi> (a', D (J.cod j))
(\<phi> (a', D (J.cod j)) (\<chi> j \<cdot> \<psi> (a', a) (S.Fun ?f e)))"
by simp
moreover have "\<chi> j \<cdot> \<psi> (a', a) (S.Fun ?f e) \<in> C.hom a' (D (J.cod j))"
using a a' j fe Hom.\<psi>_mapsto \<chi>.preserves_hom [of j "J.dom j" "J.cod j"]
\<chi>.A.map_simp
by auto
moreover have "S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun ?f e) =
S.Fun (\<sigma> j) e"
proof -
have "S.Fun (YoD.at a' (map o \<chi>) j) (S.Fun ?f e)
= (S.Fun (YoD.at a' (map o \<chi>) j) o S.Fun ?f) e"
by simp
also have "... = S.Fun (YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f) e"
using Fun_map_a_a' a a' j f e x Yo\<chi>_a'.A.map_simp eval_at_ide
by auto
also have "... = S.Fun (\<sigma> j) e"
proof -
have "YoD.at a' (map o \<chi>) j \<cdot>\<^sub>S ?f =
YoD_a'.cones_map ?f (YoD.at a' (map o \<chi>)) j"
using j f Yo\<chi>_a'.cone_axioms Fun_map_a_a' by auto
thus ?thesis using j ff by argo
qed
finally show ?thesis by auto
qed
ultimately show ?thesis
using a a' Hom.\<psi>_\<phi> by auto
qed
also have "... = D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi> j"
using j 2 \<chi>.cone_axioms by force
finally show "D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> j =
D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi> j"
by auto
qed
ultimately show "D.cones_map (\<psi> (a', a) (S.Fun f' e)) \<chi> j =
D.cones_map (\<psi> (a', a) (S.Fun ?f e)) \<chi> j"
by auto
qed
hence "\<psi> (a', a) (S.Fun f' e) = \<psi> (a', a) (S.Fun ?f e)"
using 12 \<chi>ofe.cone_axioms \<chi>.cone_axioms \<chi>.is_universal by blast
hence "\<phi> (a', a) (\<psi> (a', a) (S.Fun f' e)) = \<phi> (a', a) (\<psi> (a', a) (S.Fun ?f e))"
by simp
thus "S.Fun f' e = S.Fun ?f e"
using a a' fe f'e Hom.\<phi>_\<psi> by force
qed
ultimately show "S.Fun f' e = S.Fun ?f e" by auto
qed
qed
qed
ultimately have "\<exists>!f. \<guillemotleft>f : x \<rightarrow>\<^sub>S Hom.map (a', a)\<guillemotright> \<and>
YoD_a'.cones_map f (YoD.at a' (map o \<chi>)) = \<sigma>"
using ex1I [of"\<lambda>f. S.in_hom x (Hom.map (a', a)) f \<and>
YoD_a'.cones_map f (YoD.at a' (map o \<chi>)) = \<sigma>"]
by blast
thus "\<exists>!f. \<guillemotleft>f : x \<rightarrow>\<^sub>S Cop_S.Map (map a) a'\<guillemotright> \<and>
YoD_a'.cones_map f (YoD.at a' (map o \<chi>)) = \<sigma>"
using a a' Y_def by simp
qed
qed
thus "YoD.has_as_limit (map a)"
using YoD.cone_is_limit_if_pointwise_limit Yo\<chi>.cone_axioms by auto
qed
end
end
Messung V0.5 in Prozent
¤ Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.0.543Bemerkung:
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.
