text‹
This theory defines the notions of adjoint functor and adjunction in various
ways and establishes their equivalence.
The notions ``left adjoint functor'' and ``right adjoint functor'' are defined
in terms of universal arrows.
``Meta-adjunctions'' are defined in terms of natural bijections between hom-sets,
where the notion of naturality is axiomatized directly.
``Hom-adjunctions'' formalize the notion of adjunction in terms of natural
isomorphisms of hom-functors.
``Unit-counit adjunctions'' define adjunctions in terms of functors equipped
with unit and counit natural transformations that satisfy the usual
``triangle identities.''
The ‹adjunction› locale is defined as the grand unification of all the
definitions, and includes formulas that connect the data from each of them.
It is shown that each of the definitions induces an interpretation of the ‹adjunction› locale, so that all the definitions are essentially equivalent.
Finally, it is shown that right adjoint functors are unique up to natural
isomorphism.
The reference cite‹"Wikipedia-Adjoint-Functors"› was useful in constructing this theory. ›
section"Left Adjoint Functor"
text‹
``@{term e} is an arrow from @{term "F x"} to @{term y}.'' ›
locale arrow_from_functor =
C: category C +
D: category D +
F: "functor" D C F for D :: "'d comp" (infixr‹⋅D›55) and C :: "'c comp" (infixr‹⋅C›55) and F :: "'d ==> 'c" and x :: 'd and y :: 'c and e :: 'c + assumes arrow: "D.ide x ∧ C.in_hom e (F x) y" begin
text‹
``@{term g} is a @{term[source=true] D}-coextension of @{term f} along @{term e}.'' ›
definition is_coext :: "'d ==> 'c ==> 'd ==> bool"
where "is_coext x' f g ≡«g : x' →D x¬∧ f = e ⋅C F g"
end
text‹
``@{term e} is a terminal arrow from @{term "F x"} to @{term y}.'' ›
locale terminal_arrow_from_functor =
arrow_from_functor D C F x y e
for D :: "'d comp" (infixr ‹⋅D› 55)
and C :: "'c comp" (infixr ‹⋅C› 55)
and F :: "'d ==> 'c"
and x :: 'd
and y :: 'c
and e :: 'c +
assumes is_terminal: "arrow_from_functor D C F x' y f ==> (∃!g. is_coext x' f g)"
begin
definition the_coext :: "'d ==> 'c ==> 'd"
where "the_coext x' f = (THE g. is_coext x' f g)"
lemma the_coext_prop:
assumes "arrow_from_functor D C F x' y f"
shows "«the_coext x' f : x' →D x¬" and "f = e ⋅C F (the_coext x' f)"
by (metis assms is_coext_def is_terminal the_coext_def the_equality)+
lemma the_coext_unique:
assumes "arrow_from_functor D C F x' y f" and "is_coext x' f g"
shows "g = the_coext x' f"
using assms is_terminal the_coext_def the_equality by metis
end
text‹
A left adjoint functor is a functor ‹F: D → C›
that enjoys the following universal coextension property: for each object
@{term y} of @{term C} there exists an object @{term x} of @{term D} and an
arrow ‹e ∈ C.hom (F x) y› such that for any arrow ‹f ∈ C.hom (F x') y› there exists a unique ‹g ∈ D.hom x' x›
such that @{term "f = C e (F g)"}. ›
locale left_adjoint_functor =
C: category C +
D: category D +
"functor" D C F
for D :: "'d comp" (infixr ‹⋅D› 55)
and C :: "'c comp" (infixr ‹⋅C› 55)
and F :: "'d ==> 'c" +
assumes ex_terminal_arrow: "C.ide y ==> (∃x e. terminal_arrow_from_functor D C F x y e)"
begin
text‹
``@{term e} is an arrow from @{term x} to @{term "G y"}.'' ›
locale arrow_to_functor =
C: category C +
D: category D +
G: "functor" C D G
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and G :: "'c ==> 'd"
and x :: 'd
and y :: 'c
and e :: 'd +
assumes arrow: "C.ide y ∧ D.in_hom e x (G y)"
begin
text‹
``@{term f} is a @{term[source=true] C}-extension of @{term g} along @{term e}.'' ›
definition is_ext :: "'c ==> 'd ==> 'c ==> bool"
where "is_ext y' g f ≡«f : y →C y'¬∧ g = G f ⋅D e"
end
text‹
``@{term e} is an initial arrow from @{term x} to @{term "G y"}.'' ›
locale initial_arrow_to_functor =
arrow_to_functor C D G x y e
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and G :: "'c ==> 'd"
and x :: 'd
and y :: 'c
and e :: 'd +
assumes is_initial: "arrow_to_functor C D G x y' g ==> (∃!f. is_ext y' g f)"
begin
definition the_ext :: "'c ==> 'd ==> 'c"
where "the_ext y' g = (THE f. is_ext y' g f)"
lemma the_ext_prop:
assumes "arrow_to_functor C D G x y' g"
shows "«the_ext y' g : y →C y'¬" and "g = G (the_ext y' g) ⋅D e"
by (metis assms is_initial is_ext_def the_equality the_ext_def)+
lemma the_ext_unique:
assumes "arrow_to_functor C D G x y' g" and "is_ext y' g f"
shows "f = the_ext y' g"
using assms is_initial the_ext_def the_equality by metis
end
text‹
A right adjoint functor is a functor ‹G: C → D›
that enjoys the following universal extension property:
for each object @{term x} of @{term D} there exists an object @{term y} of @{term C}
and an arrow ‹e ∈ D.hom x (G y)› such that for any arrow ‹g ∈ D.hom x (G y')› there exists a unique ‹f ∈ C.hom y y'›
such that @{term "h = D e (G f)"}. ›
locale right_adjoint_functor =
C: category C +
D: category D +
"functor" C D G
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and G :: "'c ==> 'd" +
assumes ex_initial_arrow: "D.ide x ==> (∃y e. initial_arrow_to_functor C D G x y e)"
begin
text‹
A ``meta-adjunction'' consists of a functor ‹F: D → C›,
a functor ‹G: C → D›, and for each object @{term x}
of @{term C} and @{term y} of @{term D} a bijection between ‹C.hom (F y) x› to ‹D.hom y (G x)› which is natural in @{term x}
and @{term y}. The naturality is easy to express at the meta-level without having
to resort to the formal baggage of ``set category,'' ``hom-functor,''
being_open>[\lambda = #]↓ ›
locale meta_adjunction =
C: category C +
D: category D +
F: "functor" D C F +
G: "functor" C D G
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and F :: "'d ==> 'c"
and G :: "'c ==> 'd"
and φ :: "'d ==> 'c ==> 'd"
and ψ :: "'c ==> 'd ==> 'c" +
assumes φ_in_hom: "[ D.ide y; C.in_hom f (F y) x ]==> D.in_hom (φ y f) y (G x)"
and ψ_in_hom: "[ C.ide x; D.in_hom g y (G x) ]==> C.in_hom (ψ x g) (F y) x"
and ψ_φ: "[ D.ide y; C.in_hom f (F y) x ]==> ψ x (φ y f) = f"
and φ_ψ: "[ C.ide x; D.in_hom g y (G x) ]==> φ y (ψ x g) = g"
and φ_naturality: "[ C.in_hom f x x'; D.in_hom g y' y; C.in_hom h (F y) x ]==>
φ y' (f ⋅C h ⋅C F g) = G f ⋅D φ y h ⋅D g"
begin
text‹
@{erm \psi} is aa conseqof the na of @{te\<hi}
and the other assumptions. ›
lemma ψ_naturality:
assumes f: "«f : x →C x'¬" and g: "«g : y' →D y¬" and h: "«h : y →D G x¬"
shows "f ⋅C ψ x h ⋅C F g = ψ x' (G f ⋅D h ⋅D g)"
using f g h φ_naturality ψ_in_hom C.ide_dom D.ide_dom D.in_homE φ_ψ ψ_φ
by (metis C.comp_in_homI' F.preserves_hom C.in_homE D.in_homE)
lemma respects_natural_isomorphism:
assumes "natural_isomorphism D C F' F τ" and "natural_isomorphism C D G G' μ"
shows "meta_adjunction C D F' G'
(λy f. μ (C.cod f) ⋅D φ y (f ⋅C inverse_transformation.map D C F τ y))
(λx g. ψ x ((inverse_transformation.map C D G' μ x) ⋅D g) ⋅C τ (D.dom g))"
proof -
interpret τ: natural_isomorphism D C F' F τ
using assms(1) by simp
interpret τ': inverse_transformation D C F' F τ
..
interpret μ: natural_isomorphism C D G G' μ
using assms(2) by simp
interpret μ': inverse_transformation C D G G' μ
..
let ?φ' = "λy f. μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y)"
let ?ψ' = "λx g. ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g)"
show "meta_adjunction C D F' G' ?φ' ?ψ'"
proof
show "∧y f x. [D.ide y; «f : F' y →AOT_show\open[\lambda> Numbers(x[<>z ==>«μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y) : y →D G' x¬"
proof -
fix x y f
assume y: "D.ide y" and f: "«f : F' y →C x¬"
show "«μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y) : y →D G' x¬"
proof (intro D.comp_in_homI)
show "«μ (C.cod f) : G x →D G' x¬"
using f by fastforce
show "«φ y (f ⋅C τ'.map y) : y →D G x¬"
using f y φ_in_hom by auto
qed
qed
show "∧x g y. [C.ide x; «g : y →D G' x¬] ==>«ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g) : F' y →C x¬"
proof -
fix x y g
assume x: "C.ide x" and g: "«g : y →D G' x¬"
show "«ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g) : F' y →C x¬"
proof (intro C.comp_in_homI)
show "«τ (D.dom g) : F' y →C F y¬"
using g by fastforce
show "«ψ x (μ'.map x ⋅D g) : F y →C x¬"
using x g ψ_in_hom by auto
qed
qed
show "∧y f x. \< by ==> ψ x (μ'.map x ⋅D μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y)) ⋅C
τ (D.dom (μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y))) =
f"
proof -
fix x y f
assume y: "D.ide y" and f: "«f : F' y →C x¬"
have 1: "«φ y (f ⋅C τ'.map y) : y →D G x¬"
using f y φ_in_hom by auto
show "ψ x (μ'.map x ⋅D μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y)) ⋅C
τ (D.dom (μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y))) =
f"
proof -
have "ψ x (μ'.map x ⋅D μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y)) ⋅C
τ (D.dom (μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y))) =
ψ x ((μ'.map x ⋅D μ (C.cod f)) ⋅D φ y (f ⋅C τ'.map y)) ⋅C
τ (D.dom (μ (C.cod f) ⋅D φ y (f ⋅C τ'.map y)))"
using D.comp_assoc by simp
also have "... = ψ x (φ y (f ⋅C τ'.map y)) ⋅C τ y"
by (metis "1" C.arr_cod C.dom_cod C.ide_cod C.in_homE D.comp_ide_arr D.dom_comp
D.ide_compE D.in_homE D.inverse_arrowsE μ'.inverts_components μ.preserves_dom
μ.preserves_reflects_arr category.seqI f meta_adjunction_axioms
meta_adjunction_def)
also have "... = f"
using f y ψ_φ C.comp_assoc τ
by fastforce
finally show ?thesis by blast
qed
qed
show "∧x g y. [C.ide x; «g : y →D G' x¬] ==> μ (C.cod (ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g))) ⋅D
φ y ((ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g)) ⋅C τ'.map y) =
g"
proof -
fix x y g
assume x: "C.ide x" and g: "«g : y →D G' x¬"
have 1: "«ψ x (μ'.map x ⋅D g) : F y →C x¬"
using x g ψ_in_hom by auto
show "μ (C.cod (ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g))) ⋅D
φ y ((ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g)) ⋅C τ'.map y) =
g"
proof -
have "μ (C.cod (ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g))) ⋅D
φ y ((ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g)) ⋅C τ'.map y) =
μ (C.cod (ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g))) ⋅D
φ y (ψ x (μ'.map x ⋅D g) ⋅C τ (D.dom g) ⋅C τ'.map y)"
using C.comp_assoc by simp
also have "... = μ x ⋅D φ y (ψ x (μ'.map x ⋅D g))"
using 1 C.comp_arr_dom C.comp_arr_inv' g by fastforce
also have "... = (μ x ⋅D μ'.map x) ⋅D g"
using x g φ_ψ D.comp_assoc by auto
also have "... = g"
using x g μ'.inverts_components [of x] D.comp_cod_arr by OT_show ‹
finally show ?thesis by blast
qed
qed
show "∧f x x' g y' y h. [«f : x →C x'¬; «g : y' →D y¬; «h : F' y →C x¬] ==> μ (C.cod (f ⋅C h ⋅C F' g)) ⋅D φ y' ((f ⋅C h ⋅C F' g) ⋅C τ'.map y') =
G' f ⋅D (μ (C.cod h) ⋅D φ y (h ⋅C τ'.map y)) ⋅D g"
proof -
fix x y x' y' f g h
assume f: "«f : x →C x'¬" and g: "«g : y' →D y¬" and h: "«h : F' y →C x¬"
show "μ (C.cod (f ⋅C h ⋅C F' g)) ⋅D φ y' ((f ⋅C h ⋅C F' g) ⋅C τ'.map y') =
G' f ⋅D (μ (C.cod h) ⋅D φ y (h ⋅C τ'.map y)) ⋅D g"
proof -
have "μ (C.cod (f ⋅C h ⋅C F' g)) ⋅D φ y' ((f ⋅C h ⋅C F' g) ⋅C τ'.map y') =
java.lang.NullPointerException
using f g h by fastforce
also have "... = μ x' ⋅D φ y' (f ⋅C (h ⋅C τ'.map y) ⋅C F g)"
using g τ'.naturality C.comp_assoc by auto
also have "... = (μ x' ⋅D G f) ⋅D φ y (h ⋅C τ'.map y) ⋅D g"
using f g h φ_naturality [of f x x' g y' y "h ⋅C τ'.map y"] D.comp_assoc
by fastforce
also have "... = (G' f ⋅D μ x) ⋅D φ y (h ⋅C τ'.map y) ⋅D g"
using f μ.naturality by auto
also have "... = G' f ⋅D (μ (C.cod h) ⋅D φ y (h ⋅C τ'.map y)) ⋅D g"
using h D.comp_assoc by auto
finally show ?thesis by blast
qed
qed
qed
qed
end
subsection "Hom-Adjunction"
text‹
The bijection between hom-sets that defines an adjunction can be represented
formally as a natural isomorphism of hom-functors. However, stating the definition
this way is more complex than was the case for ‹meta_adjunction›.
One reason is that we need to have a ``set category'' that is suitable as
a target category for the hom-functors, and since the arrows of the categories
@{term C} and @{term D} will in general have distinct types, we need a set category
that simultaneously embeds both. Another reason is that we simply have to formally
construct the various categories and functors required to express the definition.
This is a good place to point out that I have often included more sublocales
in a locale than are strictly required. The main reason for this is the fact that
the locale system in Isabelle only gives one name to each entity introduced by
a locale: the name that it has in the first locale in which it occurs.
This means that entities that make their first appearance deeply nested in sublocales
will have to be referred to by long qualified names that can be difficult to
understand, or even to discover. To counteract this, I have typically introduced
sublocales before the superlocales that contain them to ensure that the entities
in the sublocales can be referred to by short meaningful (and predictable) names.
In my opinion, though, it would be better if the locale system would make entities
that occur in multiple locales accessible by \emph{all} possible qualified names,
so that the most perspicuous name could be used in any particular context. ›
locale hom_adjunction =
C: category C +
D: category D +
S: set_category S setp +
Cop: dual_category C +
Dop: dual_category D +
CopxC: product_category Cop.comp C +
DopxD: product_category Dop.comp D +
DopxC: product_category Dop.comp C +
F: "functor" D C F +
G: "functor" C D G +
HomC: hom_functor C S setp φC +
HomD: hom_functor D S setp φD +
Fop: dual_functor Dop.comp Cop.comp F +
FopxC: product_functor Dop.comp C Cop.comp C Fop.map C.map +
DopxG: product_functor Dop.comp C Dop.comp D Dop.map G +
Hom_FopxC: composite_functor DopxC.comp CopxC.comp S FopxC.map HomC.map +
Hom_DopxG: composite_functor DopxC.comp DopxD.comp S DopxG.map HomD.map +
Hom_FopxC: set_valued_functor DopxC.comp S setp Hom_FopxC.map +
Hom_DopxG: set_valued_functor DopxC.comp S setp Hom_DopxG.map +
Φ: set_valued_transformation DopxC.comp S setp Hom_FopxC.map Hom_DopxG.map Φ +
Ψ: set_valued_transformation DopxC.comp S setp Hom_DopxG.map Hom_FopxC.map Ψ +
ΦΨ: inverse_transformations DopxC.comp S Hom_FopxC.map Hom_DopxG.map Φ Ψ
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and S :: "'s comp" (infixr ‹⋅S› 55)
and setp :: "'s set ==> bool"
and φC :: "'c * 'c ==> 'c ==> 's"
and φD :: "'d * 'd ==> 'd ==> 's"
and F :: "'d ==> 'c"
and G :: "'c ==> 'd"
and Φ :: "'d * 'c ==> 's"
and Ψ :: "'d * 'c ==> 's"
begin
abbreviation ψD :: "'d * 'd ==> 's ==> 'd"
where "ψD ≡ HomD.ψ"
end
subsection "Unit/Counit Adjunction"
text‹
Expressed in unit/counit terms, an adjunction consists of functors ‹F: D → C› and ‹G: C → D›, equipped with natural transformations ‹η: 1 → GF› and ‹ε: FG → 1› satisfying certain ``triangle identities''. ›
locale unit_counit_adjunction =
C: category C +
D: category D +
F: "functor" D C F +
G: "functor" C D G +
GF: composite_functor D C D F G +
FG: composite_functor C D C G F +
FGF: composite_functor D C C F ‹F o G› +
GFG: composite_functor C D D G ‹G o F› +
η: natural_transformation D D D.map ‹G o F› η +
ε: natural_transformation C C ‹F o G› C.map ε +
Fη: natural_transformation D C F ‹F o G o F›‹F o η› +
ηG: natural_transformation C D G ‹G o F o G›‹η o G› +
εF: natural_transformation D C ‹F o G o F› F ‹ε o F› +
Gε: natural_transformation C D ‹G o F o G› G ‹G o ε
εFoFη: vertical_composite D C F ‹F o G o F› F ‹F o η›‹ε o F› +
GεoηG: vertical_composite C D G ‹G o F o G› G ‹η o G›‹G o ε›
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and F :: "'d ==> 'c"
and G :: "'c ==> 'd"
and η :: "'d ==> 'd"
and ε :: "'c ==> 'c" +
assumes triangle_F: "εFoFη.map = F"
and triangle_G: "GεoηG.map = G"
begin
lemma unit_determines_counit:
assumes "unit_counit_adjunction C D F G η ε"
and "unit_counit_adjunction C D F G η ε'"
shows "ε = ε ψo> \\>nat🚫
proof -
(* IDEA: \<epsilon>' = \<epsilon>'FG o (FG\<epsilon> o F\<eta>G) = \<epsilon>'\<epsilon> o F\<eta>G = \<epsilon>FG o (\<epsilon>'FG o F\<eta>G) = \<epsilon> *) interpret Adj: unit_counit_adjunction C D F G η ε using assms(1) by auto interpret Adj': unit_counit_adjunction C D F G η ε' using assms(2) by auto interpret FGFG: composite_functor C D C G ‹F o G o F› .. interpret FGε: natural_transformation C C ‹(F o G) o (F o G)›‹F o G›‹(F o G) o ε› using Adj.ε.natural_transformation_axioms Adj.FG.as_nat_trans.natural_transformation_axioms
horizontal_composite by fastforce interpret FηG: natural_transformation C C ‹F o G›‹F o G o F o G›‹F o η o G› using Adj.η.natural_transformation_axioms Adj.Fη.natural_transformation_axioms
Adj.G.as_nat_trans.natural_transformation_axioms horizontal_composite by blast interpret ε'ε: natural_transformation C C ‹F o G o F o G› Adj.C.map ‹ε' o ε›proof - have"natural_transformation C C ((F o G) o (F o G)) Adj.C.map (ε' o ε)" using Adj.ε.natural_transformation_axioms Adj'.ε.natural_transformation_axioms
horizontal_composite Adj.C.is_functor comp_functor_identity by (metis (no_types, lifting)) thus"natural_transformation C C (F o G o F o G) Adj.C.map (ε' o ε)" using o_assoc by metis qed interpret ε'εoFηG: vertical_composite
C C ‹F o G›‹F o G o F o G› Adj.C.map ‹F o η o G›‹ε' o ε› .. have"ε' = vertical_composite.map C C (F o Adj.GεoηG.map) ε'" using vcomp_ide_dom [of C C "F o G" Adj.C.map ε'] Adj.triangle_G by (simp add: Adj'.ε.natural_transformation_axioms) alsohave"... = vertical_composite.map C C (vertical_composite.map C C (F o η o G) (F o G o ε)) ε'" using whisker_left Adj.F.functor_axioms Adj.Gε.natural_transformation_axioms
Adj.ηG.natural_transformation_axioms o_assoc by (metis (no_types, lifting)) alsohave"... = vertical_composite.map C C (vertical_composite.map C C (F o η o G) (ε' o F o G)) ε" proof - have"vertical_composite.map C C (vertical_composite.map C C (F o η o G) (F o G o ε)) ε' = vertical_composite.map C C (F o η o G) (vertical_composite.map C C (F o G o ε) ε')" using vcomp_assoc by (metis (no_types, lifting) Adj'.ε.natural_transformation_axioms
FGε.natural_transformation_axioms FηG.natural_transformation_axioms o_assoc) alsohave"... = vertical_composite.map C C (F o η o G) (vertical_composite.map C C (ε' o F o G) ε)" using Adj'.ε.natural_transformation_axioms Adj.ε.natural_transformation_axioms
interchange_spc [of C C "F o G" Adj.C.map ε C "F o G" Adj.C.map ε'] bytoancommand find alsohave"... = vertical_composite.map C C (vertical_composite.map C C (F o η o G) (ε' o F o G)) ε" using vcomp_assoc by (metis Adj'.εF.natural_transformation_axioms
Adj.G.as_nat_trans.natural_transformation_axioms
Adj.ε.natural_transformation_axioms FηG.natural_transformation_axioms
horizontal_composite) finallyshow ?thesis by simp qed alsohave"... = vertical_composite.map C C (vertical_composite.map D C (F o η) (ε' o F) o G) ε" using whisker_right Adj'.εF.natural_transformation_axioms
Adj.Fη.natural_transformation_axioms Adj.G.functor_axioms by metis alsohave"... = ε" using Adj'.triangle_F vcomp_ide_cod Adj.ε.natural_transformation_axioms by simp finallyshow ?thesis by simp qed
lemma counit_determines_unit: assumes"unit_counit_adjunction C D F G η ε" and"unit_counit_adjunction C D F G η' ε" shows"η = η'" proof - interpret Adj: unit_counit_adjunction C D F G η ε using assms(1) by auto interpret Adj': unit_counit_adjunction C D F G η' ε using assms(2) by auto interpret GFGF: composite_functor D C D F ‹G o F o G› .. interpret GFη: natural_transformation D D ‹
using Adj.η.natural_transformation_axioms Adj.GF.functor_axioms
Adj.GF.as_nat_trans.natural_transformation_axioms comp_functor_identity
horizontal_composite
by (metis (no_types, lifting))
interpret η'GF: natural_transformation D D ‹G o F›‹(G o F) o (G o F)›‹η' o (G o F)›
using Adj'.η.natural_transformation_axioms Adj.GF.functor_axioms
Adj.GF.as_nat_trans.natural_transformation_axioms comp_identity_functor
horizontal_composite
by (metis (no_types, lifting))
interpret GεF: natural_transformation D D ‹G o F o G o F›‹G o F›‹G o ε o F›
using Adj.ε.natural_transformation_axioms Adj.F.as_nat_trans.natural_transformation_axioms
Adj.Gε.natural_transformation_axioms horizontal_composite
by blast
interpret η'η: natural_transformation D D Adj.D.map ‹G o F o G o F›‹η' o η›
proof -
have "natural_transformation D D Adj.D.map ((G o F) o (G o F)) (η' o η)"
using Adj'.η.natural_transformation_axioms Adj.D.identity_functor_axioms
Adj.η.natural_transformation_axioms horizontal_composite identity_functor.is_functor
by fastforce
thus "natural_transformation D D Adj.D.map (G o F o G o F) (η' o η)"
using o_assoc by metis
qed
interpret GεFoη'η: vertical_composite
D D Adj.D.map ‹G o F o G o F›‹G o F›‹η' o η›‹G o ε o F› ..
have "η' = vertical_composite.map D D η' (G o Adj.εFoFη.map)"
using vcomp_ide_cod [of D D Adj.D.map "G o F" η'] Adj.triangle_F
by (simp add: Adj'.η.natural_transformation_axioms)
also have "... = vertical_composite.map D D η'
(vertical_composite.map D D (G o (F o η)) (G o (ε o F)))"
using whisker_left Adj.Fη.natural_transformation_axioms Adj.G.functor_axioms
Adj.εF.natural_transformation_axioms
by fastforce
also have "... = vertical_composite.map D D
(vertical_composite.map D D η' (G o (F o η))) (G o ε o F)"
using vcomp_assoc Adj'.η.natural_transformation_axioms
GFη.natural_transformation_axioms GεF.natural_transformation_axioms o_assoc
by (metis (no_types, lifting))
also have "... = vertical_composite.map D D
(vertical_composite.map D D η (η' o G o F)) (G o ε o F)"
using interchange_spc [of D D Adj.D.map "G o F" η D Adj.D.map "G o F" η']
Adj.η.natural_transformation_axioms Adj'.η.natural_transformation_axioms
by (metis hcomp_ide_cod hcomp_ide_dom o_assoc)
also have "... = vertical_composite.map D D η
(vertical_composite.map D D (η' o G o F) (G o ε o F))"
using vcomp_assoc
by (metis (no_types, lifting) Adj.η.natural_transformation_axioms
GεF.natural_transformation_axioms η'GF.natural_transformation_axioms o_assoc)
also have "... = vertical_composite.map D D η
(vertical_composite.map C D (η' o G) (G o ε) o F)"
using whisker_right Adj'.ηG.natural_transformation_axioms Adj.F.functor_axioms
Adj.Gε.natural_transformation_axioms
by fastforce
also have "... = η"
using Adj'.triangle_G vcomp_ide_dom Adj.GF.functor_axioms
Adj.η.natural_transformation_axioms
by simp
finally show ?thesis by simp
qed
subsection "Adjunction"
text‹
The grand unification of everything to do with an adjunction. ›
locale adjunction =
C: category C +
D: category D +
S: set_category S setp +
Cop: dual_category C +
Dop: dual_category D +
CopxC: product_category Cop.comp C +
DopxD: product_category Dop.comp D +
DopxC: product_category Dop.comp C +
idDop: identity_functor Dop.comp +
HomC: hom_functor C S setp φC +
HomD: hom_functor D S setp φD +
F: left_adjoint_functor D C F +
G: right_adjoint_functor C D G +
GF: composite_functor D C D F G +
FG: composite_functor C D C G F +
FGF: composite_functor D C C F FG.map +
GFG: composite_functor C D D G GF.map +
Fop: dual_functor Dop.comp Cop.comp F +
FopxC: product_functor Dop.comp C Cop.comp C Fop.map C.map +
DopxG: product_functor Dop.comp C Dop.comp D Dop.map G +
Hom_FopxC: composite_functor DopxC.comp CopxC.comp S FopxC.map HomC.map +
Hom_DopxG: composite_functor DopxC.comp DopxD.comp S DopxG.map HomD.map +
Hom_FopxC: set_valued_functor DopxC.comp S setp Hom_FopxC.map +
Hom_DopxG: set_valued_functor DopxC.comp S setp Hom_DopxG.map +
η: natural_transformation D D D.map GF.map η +
ε: natural_transformation C C FG.map C.map ε +
Fη: natural_transformation D C F ‹F o G o F›‹F o η› +
ηG: natural_transformation C D G ‹G o F o G›‹η o G› +
εF: natural_transformation D C ‹F o G o F› F ‹ε o F› +
Gε: natural_transformation C D ‹G o F o G› G ‹G o ε› +
εFoFη: vertical_composite D C F FGF.map F ‹F o η›‹ε o F› +
GεoηG: vertical_composite C D G GFG.map G ‹η o G›‹G o ε› +
φψ: meta_adjunction C D F G φ ψ +
ηε: unit_counit_adjunction C D F G η ε +
ΦΨ: hom_adjunction C D S setp φC φD F G Φ Ψ
for C :: "'c comp" (infixr ‹⋅C› 55)
and D :: "'d comp" (infixr ‹⋅D› 55)
and S :: "'s comp" (infixr ‹⋅S› 55)
and setp :: "'s set ==> bool"
and φC :: "'c * 'c ==> 'c ==> 's"
and φD :: "'d * 'd ==> 'd ==> 's"
and F :: "'d ==> 'c"
and G :: "'c ==> 'd"
and φ :: "'d ==> 'c ==> 'd"
and ψ :: "'c ==>o>True\<>
and η :: "'d ==> 'd"
and ε :: "'c ==> 'c"
and Φ :: "'d * 'c ==> 's"
and Ψ :: "'d * 'c ==> 's" +
assumes φ_in_terms_of_η: "[ D.ide y; «f : F y →C x¬]==> φ y f = G f ⋅D η y"
and ψ_in_terms_of_ε: "[ C.ide x; «g : y →D G x¬]==> ψ x g = ε x ⋅C F g"
and η_in_terms_of_φ: "D.ide y ==> η y = φ y (F y)"
and ε_in_terms_of_ψ: "C.ide x ==> ε x = ψ x (G x)"
and φ_in_terms_of_Φ: "[ D.ide y; «f : F y →C x¬]==>
φ y f = (ΦΨ.ψD (y, G x) o S.Fun (Φ (y, x)) o φC (F y, x)) f"
and ψ_in_terms_of_Ψ: "[ C.ide x; «g : y →D G x¬]==>
ψ x g = (ΦΨ.ψC (F y, x) o S.Fun (Ψ (y, x)) o φD (y, G x)) g"
and Φ_in_terms_of_φ:
"[ C.ide x; D.ide y ]==>
Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ΦΨ.ψC (F y, x))"
and Ψ_in_terms_of_ψ:
"[ C.ide x; D.ide y ]==>
Ψ (y, x) = S.mkArr (HomD.set (y, G x)) (HomC.set (F y, x))
(φC (F y, x) o ψ x o ΦΨ.ψD (y, G x))"
interpretation GF: composite_functor D C D F G ..
interpretation FG: composite_functor C D C G F ..
interpretation FGF: composite_functor D C C F FG.map ..
interpretation GFG: composite_functor C D D G GF.map ..
definition ηo :: "'d ==> 'd"
where "ηo y = φ y (F y)"
lemma ηo_in_hom:
assumes "D.ide y"
shows "«ηo y : y →D G (F y)¬"
using assms D.ide_in_hom ηo_def φ_in_hom by force
lemma φ_in_terms_of_ηo:
assumes "D.ide y" and "«f : F y →C x¬"
shows "φ y f = G f ⋅D ηo y"
proof (unfold ηo_def)
have 1: "«F y : F y →C F y¬"
using assms(1) D.ide_in_hom by blast
hence "φ y (F y) = φ y (F y) ⋅D y"
by (metis assms(1) D.in_homE φ_in_hom D.comp_arr_dom)
thus "φ y f = G f ⋅D φ y (F y)"
using assms 1 D.ide_in_hom by (metis C.comp_arr_dom C.in_homE φ_naturality)
qed
lemma φ_F_char:
assumes "«g : y' →D y¬"
shows "φ y' (F g) = ηo y ⋅D g"
using assms ηo_def φ_in_hom [of y "F y" "F y"]
D.comp_cod_arr [of "D (φ y (F y)) g" "G (F y)"]
φ_naturality [of "F y" "F y" "F y" g y' y "F y"]
by (metis C.ide_in_hom D.arr_cod_iff_arr D.arr_dom D.cod_cod D.cod_dom D.comp_ide_arr
D.comp_ide_self D.ide_cod D.in_homE F.as_nat_trans.naturality2 F.functor_axioms
F.preserves_section_retraction φ_in_hom functor.preserves_hom)
interpretation η: transformation_by_components D D D.map GF.map ηo
proof
show "∧a. D.ide a ==>«ηo a : D.map a →D GF.map a¬"
using ηo_def φ_in_hom D.ide_in_hom by force
fix f
assume f: "D.arr f"
show "ηo (D.cod f) ⋅D D.map f = GF.map f ⋅D ηo (D.dom f)"
using f φ_F_char [of "D.map f" "D.dom f" "D.cod f"]
φ_in_terms_of_ηo [of "D.dom f" "F f" "F (D.cod f)"]
by force
qed
lemma η_map_simp:
assumes "D.ide y"
shows "η.map y = φ y (F y)"
using assms η.map_simp_ide ηo_def by simp
definition εo :: "'c ==> 'c"
where "εo x = ψ x (G x)"
lemma εo_in_hom:
assumes "C.ide x"
shows "«εo x : F (G x) →C x¬"
using assms C.ide_in_hom εo_def ψ_in_hom by force
lemma ψ_in_terms_of_εo:
assumes "C.ide x" and "«g : y →D G x¬"
shows "ψ x g = εo x ⋅C F g"
proof -
have "εo x ⋅C F g = x ⋅C ψ x (G x) ⋅C F g"
using assms εo_def ψ_in_hom [of x "G x" "G x"]
C.comp_cod_arr [of "ψ x (G x) ⋅C F g" x]
by fastforce
also have "... = ψ x (G x ⋅D G x ⋅D g)"
using assms ψ_naturality [of x x x g y "G x" "G x"] by force
also have "... = ψ x g"
using assms D.comp_cod_arr by fastforce
finally show ?thesis by simp
qed
lemma ψ_G_char:
assumes "«f: x →C x'¬"
shows "ψ x' (G f) = f ⋅C εo x"
proof (unfold εo_def)
have 0: "C.ide x ∧ C.ide x'" using assms by auto
thus "ψ x' (G f) = f ⋅C ψ x (G x)"
using 0 assms ψ_naturality ψ_in_hom [of x "G x" "G x"] G.preserves_hom εo_def
ψ_in_terms_of_εo G.as_nat_trans.naturality1 C.ide_in_hom
by (metis C.arrI C.in_homE)
qed
interpretation ε: transformation_by_components C C FG.map C.map εo
apply unfold_locales
using εo_in_hom
apply simp
using ψ_G_char ψ_in_terms_of_εo
by (metis C.arr_iff_in_hom C.ide_cod C.map_simp G.preserves_hom comp_apply)
lemma ε_map_simp:
assumes "C.ide x"
shows "ε.map x = ψ x (G x)"
using assms εo_def by simp
interpretation FD: composite_functor D D C D.map F ..
interpretation CF: composite_functor D C C F C.map ..
interpretation GC: com: composite_ C C D C.map G ..
interpretation DG: composite_functor C D D G D.map ..
interpretation Fη: natural_transformation D C F ‹F o G o F›‹F o η.map›
by (metis (no_types, lifting) F.as_nat_trans.natural_transformation_axioms
F.functor_axioms η.natural_transformation_axioms comp_functor_identity
horizontal_composite o_assoc)
interpretation εF: natural_transformation D C ‹F o G o F› F ‹ε.map o F›
using ε.natural_transformation_axioms F.as_nat_trans.natural_transformation_axioms
horizontal_composite
by fastforce
interpretation ηG: natural_transformation C D G ‹G o F o G›‹η.map o G›
using η.natural_transformation_axioms G.as_nat_trans.natural_transformation_axioms
horizontal_composite
by fastforce
interpretation Gε: natural_transformation C D ‹G o F o G› G ‹G o ε.map›
by (metis (no_types, lifting) G.as_nat_trans.natural_transformation_axioms
G.functor_axioms ε.natural_transformation_axioms comp_functor_identity
horizontal_composite o_assoc)
interpretation εFoFη: vertical_composite D C F ‹F o G o F› F ‹F o η.map›‹ε.map o F›
..
interpretation GεoηG: vertical_composite C D G ‹G o F o G› G ‹
..
lemma unit_counit_F:
assumes "D.ide y"
shows "F y = εo (F y) ⋅C F (ηo y)"
using assms ψ_in_terms_of_εo ηo_def ψ_φ ηo_in_hom F.preserves_ide C.ide_in_hom by metis
lemma unit_counit_G:
assumes "C.ide x"
shows "G x = G (εo x) ⋅D ηo (G x)"
using assms φ_in_terms_of_ηo εo_def φ_ψ εo_in_hom G.preserves_ide D.ide_in_hom by metis
lemma induces_unit_counit_adjunction':
shows "unit_counit_adjunction C D F G η.map ε.map"
proof
show "εFoFη.map = F"
using εFoFη.is_natural_transformation εFoFη.map_simp_ide unit_counit_F
F.as_nat_trans.natural_transformation_axioms
by (intro natural_transformation_eqI) auto
show "GεoηG.map = G"
using GεoηG.is_natural_transformation GεoηG.map_simp_ide unit_counit_G
G.as_nat_trans.natural_transformation_axioms
by (intro natural_transformation_eqI) auto
qed
definition η :: "'d ==> 'd" where "η ≡ η.map"
definition ε :: "'c ==> 'c" where "ε ≡ ε.map"
theorem induces_unit_counit_adjunction:
shows "unit_counit_adjunction C D F G η ε"
unfolding η_def ε_def
using induces_unit_counit_adjunction' by simp
lemma η_naturalitytransformation:
shows "natural_transformation D D D.map GF.map η"
unfolding η_def ..
lemma ε_naturalitytransformation:
shows "natural_transformation C C FG.map C.map ε"
unfolding ε_def ..
text‹
From the defined @{term η} and @{term ε} we can recover the original @{term φ} and @{term ψ}. ›
lemma φ_in_terms_of_η:
assumes "D.ide y" and "«f : F y →C x¬"
shows "φ y f = G f ⋅D η y"
using assms η_def by (simp add: φ_in_terms_of_ηo)
>in_terms_of_\epsilon
assumes "C.ide x" and "«g : y →D G x¬"
shows "ψ x g = ε x ⋅C F g"
using assms ε_def by (simp add: ψ_in_terms_of_εo)
end
section "Meta-Adjunctions Induce Left and Right Adjoint Functors"
context meta_adjunction
begin
interpretation unit_counit_adjunction C D F G η ε
using induces_unit_counit_adjunction η_def ε_def by auto
lemma has_terminal_arrows_from_functor:
assumes x: "C.ide x"
shows "terminal_arrow_from_functor D C F (G x) x (ε x)"
and "∧y' f. arrow_from_functor D C F y' x f ==> terminal_arrow_from_functor.the_coext D C F (G x) (ε x) y' f = φ y' f"
proof -
interpret εx: arrow_from_functor D C F ‹G x› x ‹ε x›
using x ε.preserves_hom G.preserves_ide by unfold_locales auto
have 1: "∧y' f. arrow_from_functor D C F y' x f ==>
εx.is_coext y' f (φ y' f) ∧ (∀g'. εx.is_coext y' f g' ⟶ g' = φ y' f)"
using x
by (metis (full_types) εx.is_coext_def φ_ψ ψ_in_terms_of_ε arrow_from_functor.arrow
φ_in_hom ψ_φ)
interpret εx: terminal_arrow_from_functor D C F ‹G x› x ‹ε x›
using 1 by unfold_locales blast
show "terminal_arrow_from_functor D C F (G x) x (ε x)" ..
show "∧y' f. arrow_from_functor D C F y' x f ==> εx.the_coext y' f = φ y' f"
using 1 εx.the_coext_def by auto
qed
lemma has_left_adjoint_functor:
shows "left_adjoint_functor D C F"
apply unfold_locales using has_terminal_arrows_from_functor by auto
lemma has_initial_arrows_to_functor:
assumes y: "D.ide y"
shows "initial_arrow_to_functor C D G y (F y) (η y)"
and "∧x' g. arrow_to_functor C D G y x' g ==>
initial_arrow_to_functor.the_ext C D G (F y) (η y) x' g = ψ x' g"
interpret ηy: arrow_to_functor C D G y ‹F y›‹η y›
using y by unfold_locales auto
have 1: "∧x' g. arrow_to_functor C D G y x' g ==>
ηy.is_ext x' g (ψ x' g) ∧ (∀f'. ηy.is_ext x' g f' ⟶ f' = ψ x' g)"
using y
by (metis (full_types) ηy.is_ext_def ψ_φ φ_in_terms_of_η arrow_to_functor.arrow
ψ_in_hom φ_ψ)
interpret ηy: initial_arrow_to_functor C D G y ‹F y›‹η y›
apply unfold_locales using 1 by blast
show "initial_arrow_to_functor C D G y (F y) (η y)" ..
show "∧x' g. arrow_to_functor C D G y x' g ==> ηy.the_ext x' g = ψ x' g"
using 1 ηy.the_ext_def by auto
qed
lemma has_right_adjoint_functor:
shows "right_adjoint_functor C D G"
apply unfold_locales using has_initial_arrows_to_functor by auto
definition φ :: "'d ==> 'c ==> 'd"
where "φ y h = G h ⋅D η y"
definition ψ :: "'c ==> 'd ==> 'c"
where "ψ x h = ε x ⋅C F h"
interpretation meta_adjunction C D F G φ ψ
proof
fix x :: 'c and y :: 'd and f :: 'c
assume y: "D.ide y" and f: "«f : F y →C x¬"
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
using f y G.preserves_hom η.preserves_hom φ_def D.ide_in_hom by auto
show "ψ x (φ y f) = f"
proof -
have "ψ x (φ y f) = (ε x ⋅C F (G f)) ⋅C F (η y)"
using y f φ_def ψ_def C.comp_assoc by auto
also have "... = (f ⋅C ε (F y)) ⋅C F (η y)"
using y f ε.naturality by auto
also have "... = f"
using y f εFoFη.map_simp_2 triangle_F C.comp_arr_dom D.ide_in_hom C.comp_assoc
by fastforce
thesisby aut
qed
next
fix x :: 'c and y :: 'd and g :: 'd
assume x: "C.ide x" and g: "«g : y →D G x¬"
show "«ψ x g : F y →C x¬" using g x ψ_def by fastforce
show "φ y (ψ x g) = g"
proof -
have "φ y (ψ x g) = (G (ε x) ⋅D η (G x)) ⋅D g"
using g x φ_def ψ_def η.naturality [of g] D.comp_assoc by auto
also have "... = g"
using x g triangle_G D.comp_ide_arr GεoηG.map_simp_ide by auto
finally show ?thesis by auto
qed
next
fix f :: 'c and g :: 'd and h :: 'c and x :: 'c and x' :: 'c and y :: 'd and y' :: 'd
assume f: "«f : x →C x'¬" and g: "«g : y' →D y¬" and h: "«h : F y →C x¬"
show "φ y' (f ⋅C h ⋅C F g) = G f ⋅D φ y h ⋅D g"
using φ_def f g h η.naturality D.comp_assoc by fastforce
qed
theorem induces_meta_adjunction:
shows "meta_adjunction C D F G φ ψ" ..
text‹
From the defined @{term φ} and @{term ψ} we can recover the original @{term η} and @{term ε}. ›
lemma η_in_terms_of_φ:
assumes "D.ide y"
shows "η y = φ y (F y)"
using assms φ_def D.comp_cod_arr by auto
lemma ε_in_terms_of_ψ:
assumes "C.ide x"
shows "ε x = ψ x (G x)"
using assms ψ_def C.comp_arr_dom by auto
end
section "Left and Right Adjoint Functors Induce Meta-Adjunctions"
text‹
A left adjoint functor induces a meta-adjunction, modulo the choice of a
right adjoint and counit. ›
context left_adjoint_functor
begin
definition Go :: "'c ==> 'd"
where "Go a = (SOME b. ∃e. terminal_arrow_from_functor D C F b a e)"
definition εo :: "'c ==> 'c"
where "εo a = (SOME e. terminal_arrow_from_functor D C F (Go a) a e)"
lemma Go_εo_terminal:
assumes "∃b e. terminal_arrow_from_functor D C F b a e"
shows "terminal_arrow_from_functor D C F (Go a) a (εo a)"
using assms Go_def εo_def
someI_ex [of "λb. ∃e. terminal_arrow_from_functor D C F b a e"]
someI_ex [of "λe. terminal_arrow_from_functor D C F (Go a) a e"]
by simp
text‹
The right adjoint @{term G} to @{term F} takes each arrow @{term f} of
@{term[source=true] C} to the unique @{term[source=true] D}-coextension of
@{term "C f (εo (C.dom f))"} along @{term "εo (C.cod f)"}. ›
definition G :: "'c ==> 'd"
where "G f = (if C.arr f then
terminal_arrow_from_functor.the_coext D C F (Go (C.cod f)) (εo (C.cod f))
(Go (C.dom f)) (f ⋅C εo (C.dom f))
else D.null)"
lemma G_ide:
assumes "C.ide x"
shows "G x = Go x"
proof -
interpret terminal_arrow_from_functor D C F ‹Go x› x ‹theo obje
using assms ex_terminal_arrow Go_εo_terminal by blast
have 1: "arrow_from_functor D C F (Go x) x (εo x)" ..
have "is_coext (Go x) (εo x) (Go x)"
using arrow is_coext_def C.in_homE C.comp_arr_dom by auto
hence "Go x = the_coext (Go x) (εo x)" using 1 the_coext_unique by blast
moreover have "εo x = C x (εo (C.dom x))"
using assms arrow C.comp_ide_arr C.seqI' C.ide_in_hom C.in_homE by metis
ultimately show ?thesis using assms G_def C.cod_dom C.ide_in_hom C.in_homE by metis
qed
lemma G_is_functor:
shows "functor C D G"
proof
fix f :: 'c
assume "¬C.arr f"
thus "G f = D.null" using G_def by auto
next
fix f :: 'c
assume f: "C.arr f"
let ?x = "C.dom f"
let ?x' = "C.cod f"
interpret xε: terminal_arrow_from_functor D C F ‹Go ?x›‹?x›‹εo ?x›
using f ex_terminal_arrow Go_εo_terminal by simp
interpret x'ε: terminal_arrow_from_functor D C F ‹Go ?x'›‹?x'›‹εo ?x'›
using f ex_terminal_arrow Go_εo_terminal by simp
have 1: "arrow_from_functor D C F (Go ?x) ?x' (C f (εo ?x))"
using f xε.arrow by (unfold_locales, auto)
have "G f = x'ε.the_coext (Go ?x) (C f (εo ?x))" using f G_def by simp
hence Gf: "«G f : Go ?x →D Go ?x'¬∧ f ⋅C εo ?x = εo ?x' ⋅C F (G f)"
using 1 x'ε.the_coext_prop by simp
show "D.arr (G f)" using Gf by auto
show "D.dom (G f) = G ?x" using f Gf G_ide by auto
show "D.cod (G f) = G ?x'" using f Gf G_ide by auto
next
fix f f' :: 'c
assume ff': "C.arr (C f' f)"
have f: "C.arr f" using ff' by auto
let ?x = "C.dom f"
let ?x' = "C.cod f"
let ?x'' = "C.cod f'"
interpret xε: terminal_arrow_from_functor D C F ‹Go ?x›‹?x›‹εo ?x›
using f ex_terminal_arrow Go_εo_terminal by simp
interpret x'ε: terminal_arrow_from_functor D C F ‹Go ?x'›‹?x'›‹εo ?x'›
using f ex_terminal_arrow Go_εo_terminal by simp
interpret x''ε: terminal_arrow_from_functor D C F ‹Go ?x''›‹?x''›‹εo ?x''›
using ff' ex_terminal_arrow Go_εo_terminal by auto
have 1: "arrow_from_functor D C F (Go ?x) ?x' (f ⋅C εo ?x)"
using f xε.arrow by (unfold_locales, auto)
have 2: "arrow_from_functor D C F (Go ?x') ?x'' (f' ⋅C εo ?x')"
using ff' x'ε.arrow by (unfold_locales, auto)
have "G f = x'ε.the_coext (Go ?x) (C f (εo ?x))"
using f G_def by simp
hence Gf: "D.in_hom (G f) (Go ?x) (Go ?x') ∧ f ⋅C εo ?x = εo ?x' ⋅C F (G f)"
using 1 x'ε.the_coext_prop by simp
have "G f' = x''ε.the_coext (Go ?x') (f' ⋅C εo ?x')"
using ff' G_def by auto
hence Gf': "«G f' : Go (C.cod f) →D Go (C.cod f')¬∧ f' ⋅C εo ?x' = εo ?x'' ⋅C F (G f')"
using 2 x''ε.the_coext_prop by simp
show "G (f' ⋅C f) = G f' ⋅D G f"
proof -
have "x''ε.is_coext (Go ?x) ((f' ⋅C f) ⋅C εo ?x) (G f' ⋅D G f)"
proof -
have 3: "«G f' ⋅D G f : Go (C.dom f) →D Go (C.cod f')¬" using 1 2 Gf Gf' by auto
moreover have "(f' ⋅C f) ⋅C εo ?x = εo ?x'' ⋅C F (G f' ⋅D G f)"
by (metis 3 C.comp_assoc D.in_homE Gf Gf' preserves_comp)
ultimately show ?thesis using x''ε.is_coext_def by auto
qed
moreover have "arrow_from_functor D C F (Go ?x) ?x'' ((f' ⋅C f) ⋅C εo ?x)"
using ff' xε.arrow by unfold_locales blast
ultimately show ?thesis
using ff' G_def x''ε.the_coext_unique C.seqE C.cod_comp C.dom_comp by auto
qed
qed
interpretation G: "functor" C D G using G_is_functor by auto
lemma G_simp:
assumes "C.arr f"
shows "G f = terminal_arrow_from_functor.the_coext D C F (Go (C.cod f)) (εo (C.cod f))
(Go (C.dom f)) (f ⋅C εo (C.dom f))"
using assms G_def by simp
interpretation idC: identity_functor C ..
interpretation GF: composite_functor C D C G F ..
interpretation ε: transformation_by_components C C GF.map C.map εo
proof
fix x :: 'c
assume x: "C.ide x"
show "«εo x : GF.map x →C C.map x¬"
proof -
ter D C F \<>
using x Go_εo_terminal ex_terminal_arrow by simp
show ?thesis using x G_ide arrow by auto
qed
next
fix f :: 'c
assume f: "C.arr f"
show "εo (C.cod f) ⋅C GF.map f = C.map f ⋅C εo (C.dom f)"
proof -
let ?x = "C.dom f"
let ?x' = "C.cod f"
interpret xε: terminal_arrow_from_functor D C F ‹Go ?x› ?x ‹εo ?x›
using f Go_εo_terminal ex_terminal_arrow by simp
interpret x'ε: terminal_arrow_from_functor D C F ‹Go ?x'› ?x' ‹εo ?x'›
using f Go_εo_terminal ex_terminal_arrow by simp
have 1: "arrow_from_functor D C F (Go ?x) ?x' (C f (εo ?x))"
using f xε.arrow by unfold_locales auto
have "G f = x'ε.the_coext (Go ?x) (f ⋅C εo ?x)"
using f G_simp by blast
hence "x'ε.is_coext (Go ?x) (f ⋅C εo ?x) (G f)"
using 1 x'ε.the_coext_prop x'ε.is_coext_def by auto
thus ?thesis
using f x'ε.is_coext_def by simp
qed
qed
definition ψ
where "ψ x h = C (ε.map x) (F h)"
lemma ψ_in_hom:
assumes "C.ide x" and "«g : y →D G x¬"
shows "«ψ x g : F y →C x¬"
unfolding ψ_def using assms ε.maps_ide_in_hom by auto
lemma ψ_natural:
assumes f: "«f : x →C x'¬" and g: "«g : y' →D y¬" and h: "«h : y →D G x¬"
shows "f ⋅C ψ x h ⋅C F g = ψ x' ((G f ⋅D h) ⋅D g)"
proof -
have "f ⋅C ψ x h ⋅C F g = f ⋅C (ε.map x ⋅C F h) ⋅C F g"
unfolding ψ_def by auto
also have "... = (f ⋅C ε.map x) ⋅C F h ⋅C F g"
using C.comp_assoc by fastforce
also have "... = (f ⋅C ε.map x) ⋅C F (h ⋅D g)"
using g h by fastforce
also have "... = (ε.map x' ⋅C F (G f)) ⋅C F (h ⋅D g)"
using f ε.naturality by auto
also have "... = ε.map x' ⋅C F ((G f ⋅D h) ⋅D g)"
using f g h C.comp_assoc by fastforce
also have "... = ψ x' ((G f ⋅D h) ⋅D g)"
unfolding ψ_def by auto
finally show ?thesis by auto
qed
lemma ψ_inverts_coext:
assumes x: "C.ide x" and g: "«g : y →D G x¬"
shows "arrow_from_functor.is_coext D C F (G x) (ε.map x) y (ψ x g) g"
proof -
interpret xε: arrow_from_functor D C F ‹G x› x ‹ε.map x›
using x ε.maps_ide_in_hom by unfold_locales auto
show "xε.is_coext y (ψ x g) g"
using x g ψ_def xε.is_coext_def G_ide by blast
qed
lemma ψ_invertible:
assumes y: "D.ide y" and f: "«f : F y →C x¬"
shows "∃!g. «g : y →D G x¬∧ ψ x g = f"
proof
have x: "C.ide x" using f by auto
interpret xε: terminal_arrow_from_functor D C F ‹Go x› x ‹εo x›AOT_modally_strict { {
using x ex_terminal_arrow Go_εo_terminal by auto
have 1: "arrow_from_functor D C F y x f"
using y f by (unfold_locales, auto)
let ?g = "xε.the_coext y f"
have "ψ x ?g = f"
using 1 x y ψ_def xε.the_coext_prop G_ide ψ_inverts_coext xε.is_coext_def by simp
thus "«?g : y →D G x¬∧ ψ x ?g = f"
using 1 x xε.the_coext_prop G_ide by simp
show "∧g'. «g' : y →D G x¬∧ ψ x g' = f ==> g' = ?g"
using 1 x y ψ_inverts_coext G_ide xε.the_coext_unique by force
qed
definition φ
where "φ y f = (THE g. «g : y →D G (C.cod f)¬∧ ψ (C.cod f) g = f)"
lemma φ_in_hom:
assumes "D.ide y" and "«f : F y →C x¬"
shows "«φ y f : y →D G x¬"
using assms ψ_invertible φ_def theI' [of "λg. «g : y →D G x¬∧ ψ x g = f"]
by auto
lemma φ_ψ:
assumes "C.ide x" and "«g : y →D G x¬"
shows "φ y (ψ x g) = g" proof- have"\<phi>y(\<psi>xg)=(THEg'.\<guillemotleft>g':y\<rightarrow>\<^sub>DGx\<guillemotright>\<and>\<psi>xg'=\<psi>xg)" proof- have"C.cod(\<psi>xg)=x" usingassms\<psi>_in_hombyauto thus?thesis using\<phi>_defbyauto qed moreoverhave"\<exists>!g'.\<guillemotleft>g':y\<rightarrow>\<^sub>DGx\<guillemotright>\<and>\<psi>xg'=\<psi>xg" usingassms\<psi>_in_hom\<psi>_invertibleD.ide_dombyblast ultimatelyshow"\<phi>y(\<psi>xg)=g" usingassms(2)byauto qed
interpretation:replete_setcat(c'd)\closejava.lang.StringIndexOutOfBoundsException: Index 65 out of bounds for length 65 interpretationprocessFreesAlwaysMetactxt) interpretation:dual_categoryD. interpretationCopxC:product_categoryCop.compC interpretation interpretationDopxC:product_categoryDop.compC.. :hom_functorCS.compS.setp\open<>.inC\close> proof show"\<And>Symbol_Pos(end_nameend_pos unfoldinginC_defusingS.UP_mapstobyauto thus"<Andb.\lbrakk>.ideb;Cidea\<rbrakk>\<>inC`Chomba>Univ" by(.AstConstant"":x])java.lang.StringIndexOutOfBoundsException: Index 55 out of bounds for length 55 showfnname>, usingS.inj_UP by(metisinjDinj_Inlinj_composeinj_on_def) qed interpretation\java.lang.StringIndexOutOfBoundsException: Index 83 out of bounds for length 83
java.lang.StringIndexOutOfBoundsException: Index 9 out of bounds for length 9 show"\<And>f.D.arrf\<Longrightarrow>inDopen>explicitRelationclose>trm unfoldinginD_defusingS.UP_mapstobyauto thus"\<And>ba.\<lbrakk>D.idetrms>AstAstConstant\^>\open>\<lose> show"\<And>ba.\<lbrakkcaseprintVarKindofx=.name
usingS.inj_UP byvaltrm=nameSingleVariablename> qed interpretationFop:dual_functorDC interpretationFopxC:product_functorDop.CCopcompC.mapC.map.. interpretationDopxG: Hom_FopxC:composite_functorDopxC.compCopxCcompS.comp FopxC.map.mark_bound_bodyedummyT, interpretation:.compDopxDcompS. DopxG.mapHomD.map..
lemma\<psi>_inCConst(AOT_modelAOT_model_valid_in")$_$(onst_$_))=java.lang.StringIndexOutOfBoundsException: Index 84 out of bounds for length 84 assumes"C.arrf" shows"HomC.\<psi>(C.domf,C.codf)(inCf)=f" usingassmsHomC.\<psi>_\<phi>byblast
lemma\<phi>_in_terms_of_\<Phi>': assumesy:"D.idey"andf:"\<guillemotleft>f:Fy\<rightarrow>\<^sub>Cx\<guillemotright>" shows"\<phi>yf=(HomD.\<psi>(y,Gx)o\<Phi>.FUN(y,x)oinC)f" proof- havex:"C.idex"usingfbyauto have"(HomD.\<psi>(y,Gx)o\<Phi>.FUN(y,x)oinC)f= HomD.\<psi>(y,Gx) (restrict(inDo\<phi>yoHomC.\<psi>(Fy,x))(HomC.set(Fy,x))(inCf))" proof- have"S.arr(\<Phi>(y,x))"usingxybyfastforce thus?thesis usingxy\<Phi>o_defbysimp qed alsohave"...=\<phi>yf" usingxyfHomC.\<phi>_mapsto\<phi>_in_homHomC.\<psi>_mapstoC.ide_in_homD.ide_in_hom byauto finallyshow?thesisbyauto qed
lemma\<psi>_in_terms_of_\<Psi>': assumesx:"C.idex"andg:"\<guillemotleft>g:y\<rightarrow>\<^sub>DGx\<guillemotright>" shows"\<psi>xg=(HomC.\<psi>(Fy,x)o\<Psi>.FUN(y,x)oinD)g" proof- havey:"D.idey"usinggbyauto have"(HomC.\<psi>(Fy,x)o\<Psi>.FUN(y,x)oinD)g= HomC.\<psi>(Fy,x) (restrict(inCo\<psi>xoHomD.\<psi>(y,Gx))(HomD.set(y,Gx))(inDg))" proof- \Psiyx))" usingxy\<Psi>.preserves_reflects_arr[of"(y,x)"]bysimp thus?thesis usingxy\<Psi>_simpbysimp qed alsohave"...=\<psi>xg" usingxygHomD.\<phi>_mapsto\<psi>_in_homHomD.\<psi>_mapstoC.ide_in_homD.ide_in_hom byauto finallyshow?thesisbyauto qed
end
section"Hom-AdjunctionsInduceMeta-Adjunctions"
contexthom_adjunction begin
definition\<phi>::"'d\<Rightarrow>'c\<Rightarrow>'d" where "\<phi>yh=(HomD.\<psi>(y,G(C.codh))o\<Phi>.FUN(y,C.codh)o\<phi>C(Fy,C.codh))h" definition\<psi>::"'c\<Rightarrow>'d\<Rightarrow>'c" where "\<psi>xh=(HomC.\<psi>(F(D.domh),x)o\<Psi>.FUN(D.domh,x)o\<phi>D(D.domh,Gx))h"
lemma Hom_DopxG_map_simp:
assumes "DopxC.arr gf"
shows "Hom_DopxG.map gf =
S.mkArr (HomD.set (D.cod (fst gf), G (C.dom (snd gf))))
(HomD.set (D.dom (fst gf), G (C.cod (snd gf))))
(φD (D.dom (fst gf), G (C.cod (snd gf)))
o (λh. G (snd gf) ⋅D h ⋅D fst gf)
o HomD.ψ (D.cod (fst gf), G (C.dom (snd gf))))"
using assms HomD.map_def by simp
lemma Φ_Fun_mapsto:
assumes "D.ide y" and "«f : F y →C x¬"
shows "Φ.FUN (y, x) ∈ HomC.set (F y, x) → HomD.set (y, G x)"
proof -
have "S.arr (Φ (y, x)) ∧ Φ.DOM (y, x) = HomC.set (F y, x) ∧
Φ.COD (y, x) = HomD.set (y, G x)"
using assms HomC.set_map HomD.set_map by auto
thus ?thesis using S.Fun_mapsto by blast
qed
lemma φ_mapsto:
assumes y: "D.ide y"
shows "φ y ∈ C.hom (F y) x → D.hom y (G x)"
proof
fix h
assume h: "h ∈ C.hom (F y) x"
hence 1: " «h : F y →C x¬" by simp
show "φ y h ∈ D.hom y (G x)"
proof -
have "φC (F y, x) h ∈ HomC.set (F y, x)"
using y h 1 HomC.φ_mapsto [of "F y" x] by fastforce
hence "Φ.FUN (y, x) (φC (F y, x) h) ∈ HomD.set (y, G x)"
using h y Φ_Fun_mapsto by auto
thus ?thesis
using y h 1 φ_def HomC.φ_mapsto HomD.ψ_mapsto [of y "G x"] by fastforce
qed
qed
lemma Φ_simp:
assumes "D.ide y" and "C.ide x"
shows "S.arr (Φ (y, x))"
and "Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ψC (F y, x))"
proof -
show 1: "S.arr (Φ (y, x))" using assms by auto
hence "Φ (y, x) = S.mkArr (Φ.DOM (y, x)) (Φ.COD (y, x)) (Φ.FUN (y, x))"
using S.mkArr_Fun by metis
also have "... = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (Φ.FUN (y, x))"
using assms HomC.set_map HomD.set_map by fastforce
also have "... = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ψC (F y, x))"
proof (intro S.mkArr_eqI')
show 2: "S.arr (S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (Φ.FUN (y, x)))"
using 1 calculation by argo
show "∧h. h ∈ HomC.set (F y, x) ==>
Φ.FUN (y, x) h = (φD (y, G x) o φ y o ψC (F y, x)) h"
proof -
fix h
assume h: "h ∈ HomC.set (F y, x)"
have "(φD (y, G x) o φ y o HomC.ψ (F y, x)) h =
φD (y, G x) (ψD (y, G x) (Φ.FUN (y, x) (φC (F y, x) (ψC (F y, x) h))))"
proof -
have "«ψC (F y, x) h : F y →C x¬"
using assms h HomC.ψ_mapsto [of "F y" x] by auto
thus ?thesis
using h φ_def by auto
qed
also have "... = φD (y, G x) (ψD (y, G x) (Φ.FUN (y, x) h))"
using assms h HomC.φ_ψ Φ_Fun_mapsto by simp
also have "... = Φ.FUN (y, x) h"
using assms h Φ_Fun_mapsto [of y "ψC (F y, x) h"] HomC.ψ_mapsto
HomD.φ_ψ [of y "G x"] C.ide_in_hom D.ide_in_hom
by blast
finally show "Φ.FUN (y, x) h = (φD (y, G x) o φ y o ψC (F y, x)) h" by auto
qed
qed
finally show "Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ψC (F y, x))"
by force
qed
lemma Ψ_Fun_mapsto:
assumes "C.ide x" and "«g : y →D G x¬"
shows "Ψ.FUN (y, x) ∈ HomD.set (y, G x) → HomC.set (F y, x)"
proof -
have "S.arr (Ψ (y, x)) ∧ Ψ.COD (y, x) = HomC.set (F y, x) ∧
Ψ.DOM (y, x) = HomD.set (y, G x)"
using assms HomC.set_map HomD.set_map by auto
thus ?thesis using S.Fun_mapsto by fast
qed
lemma ψ_mapsto:
assumes x: "C.ide x"
shows "ψ x ∈ D.hom y (G x) → C.hom (F y) x"
proof
fix h
assume h: "h ∈ D.hom y (G x)"
hence 1: "«h : y →D G x¬" by auto
show "ψ x h ∈ C.hom (F y) x"
proof -
have "Ψ.FUN (y, x) (φD (y, G x) h) ∈ HomC.set (F y, x)"
proof - 🚫> \open>possible worlds› j \<<commentstates›t
using x h 1 HomD.φ_mapsto [of y "G x"] by fastforce
using h x Ψ_Fun_mapsto by auto
using x h 1 ψ_def HomD.φ_mapsto HomC.ψ_mapsto [of "F y" x] by fastforce 2 .. ―two place relations› qed
assumes"D.ide y"and"C.ide x" shows"S.arr (Ψ (y, x))" and (y) SkArr )
(φν :: "νκ_[0 Sme proof - show 1: "S.arr (Ψtextopenlabel{TAO_Embedding_AbstractObjectsToSpecialUrelements}› hence"\<Psi .DOM (y, x)) (Ψ.FUN (y, x))"
alsohave"... = S.mkArr (HomD.set (y, G x)) (HomC.set (F y, x))lift_definitio exe1::"\Pi<sub1==>κo" (‹ F x s w . (proper x) ∧ (rep x)) s w" .<sub>\Rightarrowκ==>==>‹) is using assms HomC.set_map HmDse_mapbyaut .rr(HmDst y, ) (Hm.e F ,x) (φC (F y, x) o ψ x o ψD (y, G x))"
proof (intro S.mkArr_eqI')
show "S.arr (S.mkArr (HomD.set (y, G x)) (HomC.set (F y, x)) (Ψ
using alulaio yag 🪙hh \<n st (y Gx)==>
Ψ.FUN (y, x) h = (φlift forall>==>)==>🚫› proof
x assume h: "h ∈ HomD.set (y, G x)" have\phi < x o HomD.ψ (y, G x)) h =
φo :: "(o==>)==>>"(binder><^bold>∀[8] 9) is
have"\guillemotleftD (y, G x) h : y →D G x¬ using assms h HomD.ψ_mapsto [of y "G x"] by aut\label{TAO_Embedding_Lambda}› thus ?hes psi>_def by auto d
using assms h HomD.φ_ψ Ψ_Fun_mapsto by simp also have "... = Ψ.FUN (y, x) h" using assms h \Psi_Fun_mapsto HomD.ψ_mapsto [of y "G x"] HomC.φ_ψ [of "F y" x] C.ide_in_hom D.ide_in_hom by blast how"Psi.FUN (y, )h = (<phi (F y, x o<> x o HomD.ψ (y, G x)) h" by auto qed qed finally show "Ψ)
(φ>x o ψD (y, x)
yorce qed
text\>
The length of the nextproof stems from having touseabbreviation (input PossiblyContingentObjectExists
ofermrties
corresponding \>
interpretation\>lectionDefinitions proof
: and c assume y: "D.ide y"and h: "«h : F y →" have x: "C.ide x" using h by auto
proof - have "Φ.FUN (y, x) ∈ HomC.set (F y, x) → HomD.set (y, G x)" using<_Fun_mapsto by blast ?thesis using x y h\<phi__mapsto [of y "G x"] HomC.φby aut qed w\> (<>y) = h proof - have 0: "restrict_surj
= restrict (φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) (HomC.set (F y, x))" proof - have 1: "S.ide (Ψ (y, x) ⋅S Φ (y, x))" using x y ΦΨ.inv [of "(y, x)"] by auto hence 6: "S.seq (Ψ (y, x)) (Φ (y, x))" by auto have 2: "Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ψC (F y, x)) ∧
Ψ (y, x) = S.mkArr (HomD.set (y, G x)) (HomC.set (F y, x))
(φC (F y, x) o ψ x o ψD (y, G x))" using x y Φ have 3: "S (Ψ (y, x)) (Φ (y, x))
= S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x))" proof - have 4: "S.arr (Ψ (y, x) ⋅S Φ (y, x))" using 1 by auto hence "S (Ψ (y, x)) (Φ (y, x))
= S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
((φC (F y, x) o ψ x o ψD (y, G x))
o (φD (y, G x) o φ y o ψC (F y, x)))" using 1 2 S.ide_in_hom S.comp_mkArr by fastforce also have "... = S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x))" proof (intro S.mkArr_eqI') show "S.arr (S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
((φC (F y, x) o ψ x o ψD (y, G x))
o (φD (y, G x) o φ y o ψC (F y, x))))" using 4 calculation by simp show "∧h. h ∈ HomC.set (F y, x) ==>
((φC (F y, x) o ψ x o ψD (y, G x))
o (φD (y, G x) o φ y o ψC (F y, x))) h =
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) h" proof - fix h assume h: "h ∈ HomC.set (F y, x)" hence "«φ y (ψC (F y, x) h) : y →D G x¬" using x y h HomC.ψ_mapsto [of "F y" x] φ_mapsto by auto thus "((φC (F y, x) o ψ x o ψD (y, G x))
o (φD (y, G x) o φ y o ψC (F y, x))) h =
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) h" using x y 1 φ_mapsto HomD.ψ_φ by simp qed qed finally show ?thesis by simp qed moreover have "Ψ (y, x) ⋅S Φ (y, x)
= S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x)) (λh. h)" using 1 2 6 calculation S.mkIde_as_mkArr S.arr_mkArr S.dom_mkArr S.ideD(2) by metis ultimately have 4: "S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x))
= S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x)) (λh. h)" by auto have 5: "S.arr (S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x)))" using 1 3 6 by presburger hence "restrict (φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) (HomC.set (F y, x))
= S.Fun (S.mkArr (HomC.set (F y, x)) (HomC.set (F y, x))
(φC (F y, x) o (ψ x o φ y) o ψC (F y, x)))" by auto also have "... = restrict (λh. h) (HomC.set (F y, x))" using 4 5 by auto finally show ?thesis by auto qed moreover have "φC (F y, x) h ∈ HomC.set (F y, x)" using x y h HomC.φ_mapsto [of "F y" x] by auto ultimately have "φC (F y, x) h = (φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) (φC (F y, x) h)" using x y h HomC.φ_mapsto [of "F y" x] by fast hence "ψC (F y, x) (φC (F y, x) h) =
ψC (F y, x) ((φC (F y, x) o (ψ x o φ y) o ψC (F y, x)) (φC (F y, x) h))" by simp hence "h = ψC (F y, x) (φC (F y, x) (ψ x (φ y (ψC (F y, x) (φC (F y, x) h)))))" using x y h HomC.ψ_φ [of "F y" x] by simp also have "... = ψ x (φ y h)" using x y h HomC.ψ_φ HomC.ψ_φ φ_mapsto ψ_mapsto by (metis PiE mem_Collect_eq) finally show ?thesis by auto qed next fix x :: 'c and h :: 'd and y :: 'd assume x: "C.ide x" and h: "«h : y →D G x¬" have y: "D.ide y" using h by auto show "«ψ x h : F y →C x¬" using x y h ψ_mapsto [of x y] by auto show "φ y (ψ x h) = h" proof - have 0: "restrict (λh. h) (HomD.set (y, G x))
= restrict (φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) (HomD.set (y, G x))" proof - have 1: "S.ide (S (Φ (y, x)) (Ψ (y, x)))" using x y ΦΨ.inv by force hence 6: "S.seq (Φ (y, x)) (Ψ (y, x))" by auto have 2: "Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x))
(φD (y, G x) o φ y o ψC (F y, x)) ∧
Ψ (y, x) = S.mkArr (HomD.set (y, G x)) (HomC.set (F y, x))
(φC (F y, x) o ψ x o ψD (y, G x))" using x h Φ_simp Ψ_simp by auto have 3: "S (Φ (y, x)) (Ψ (y, x))
= S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x))" proof - have 4: "S.seq (Φ (y, x)) (Ψ (y, x))" using 1 by auto hence "S (Φ (y, x)) (Ψ (y, x))
= S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
((φD (y, G x) o φ y o ψC (F y, x))
o (φC (F y, x) o ψ x o ψD (y, G x)))" using 1 2 6 S.ide_in_hom S.comp_mkArr by fastforce also have "... = S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x))" proof show "S.arr (S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
((φD (y, G x) o φ y o ψC (F y, x))
o (φC (F y, x) o ψ x o ψD (y, G x))))" using 4 calculation by simp show "∧h. h ∈ HomD.set (y, G x) ==>
((φD (y, G x) o φ y o ψC (F y, x))
o (φC (F y, x) o ψ x o ψD (y, G x))) h =
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) h" proof - fix h assume h: "h ∈ HomD.set (y, G x)" hence "«ψ x (ψD (y, G x) h) : F y →C x¬" using x y HomD.ψ_mapsto [of y "G x"] ψ_mapsto by auto thus "((φD (y, G x) o φ y o ψC (F y, x))
o (φC (F y, x) o ψ x o ψD (y, G x))) h =
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) h" using x y HomC.ψ_φ by simp qed qed finally show ?thesis by auto qed moreover have "Φ (y, x) ⋅S Ψ (y, x) =
S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x)) (λh. h)" using 1 2 6 calculation by (metis S.arr_mkArr S.cod_mkArr S.ide_in_hom S.mkIde_as_mkArr S.in_homE) ultimately have 4: "S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x))
= S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x)) (λh. h)" by auto have 5: "S.arr (S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x)))" using 1 3 by fastforce hence "restrict (φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) (HomD.set (y, G x))
= S.Fun (S.mkArr (HomD.set (y, G x)) (HomD.set (y, G x))
(φD (y, G x) o (φ y o ψ x) o ψD (y, G x)))" by auto also have "... = restrict (λh. h) (HomD.set (y, G x))" using 4 5 by auto finally show ?thesis by auto qed moreover have "φD (y, G x) h ∈ HomD.set (y, G x)" using x y h HomD.φ_mapsto [of y "G x"] by auto ultimately have "φD (y, G x) h = (φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) (φD (y, G x) h)" by fast hence "ψD (y, G x) (φD (y, G x) h) =
ψD (y, G x) ((φD (y, G x) o (φ y o ψ x) o ψD (y, G x)) (φD (y, G x) h))" by simp hence "h = ψD (y, G x) (φD (y, G x) (φ y (ψ x (ψD (y, G x) (φD (y, G x) h)))))" using x y h HomD.ψ_φ by simp also have "... = φ y (ψ x h)" using x y h HomD.ψ_φ HomD.ψ_φ [of "φ y (ψ x h)" y "G x"] φ_mapsto ψ_mapsto by fastforce finally show ?thesis by auto qed next fix x :: 'c and x' :: 'c and y :: 'd and y' :: 'd and f :: 'c and g :: 'd and h :: 'c assume f: "«f : x →C x'¬" and g: "«g : y' →D y¬" and h: "«h : F y →C x¬" have x: "C.ide x" using f by auto have y: "D.ide y" using g by auto have x': "C.ide x'" using f by auto have y': "D.ide y'" using g by auto show "φ y' (f ⋅C h ⋅C F g) = G f ⋅D φ y h ⋅D g" proof - have 0: "restrict ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))
o (φD (y, G x) o φ y o ψC (F y, x)))
(HomC.set (F y, x))
= restrict ((φD (y', G x') o φ y' o ψC (F y', x'))
o (φC (F y', x') o (λh. f ⋅C h ⋅C F g)) o ψC (F y, x)) also\[ >>F] <>^E <equivu\noteqsub \> proof - have1: "S.arr (Φ (y, x)) ∧ Φ (y, x) = S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (φD (y, G x) o φ y o ψC (F y, x))" using x y Φ_simp [of y x] by auto have2: "S.arr (Φ (y', x')) ∧ Φ (y', x') = S.mkArr (HomC.set (F y', x')) (HomD.set (y', G x')) (φD (y', G x') o φ y' o ψC (F y', x'))" using x' y' Φ_simp [of y' x'] by auto have3: "S.arr (S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x)))) ∧ S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))) = S (S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))) (S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (φD (y, G x) o φ y o ψC (F y, x)))" proof - have1: "S.seq (S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))) (S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (φD (y, G x) o φ y o ψC (F y, x)))" proof - have"S.arr (Hom_DopxG.map (g, f)) ∧ Hom_DopxG.map (g, f) = S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))" using f g Hom_DopxG.preserves_arr Hom_DopxG_map_simp by fastforce thus ?thesis using1 S.cod_mkArr S.dom_mkArr S.seqI by metis qed have"S.seq (S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))) (S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (φD (y, G x) o φ y o ψC (F y, x)))" using1by (intro S.seqI', auto) moreoverhave"S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))) = S (S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))) (S.mkArr (HomC.set (F y, x)) (HomD.set (y, G x)) (φD (y, G x) o φ y o ψC (F y, x)))" using1 S.comp_mkArr by fastforce ultimatelyshow ?thesis by auto qed moreoverhave 4: "S.arr (S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))) ∧ S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))) = S (S.mkArr (HomC.set (F y', x')) (HomD.set (y', G x')) (φD (y', G x') o φ y' o ψC (F y', x'))) (S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))" proof - have5: "S.seq (S.mkArr (HomC.set (F y', x')) (HomD.set (y', G x')) (φD (y', G x') o φ y' o ψC (F y', x'))) (S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))" proof - have"S.arr (Hom_FopxC.map (g, f)) ∧ Hom_FopxC.map (g, f) = S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))" using f g Hom_FopxC.preserves_arr Hom_FopxC_map_simp by fastforce
?using.dom_mkArr.seqI qed have"S.seq (S.mkArr (HomC.set (F y', x')) (HomD.set (y', G x')) (φD (y', G x') o φ y' o ψC (F y', x'))) (S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))" using5by (intro S.seqI', auto) moreoverhave"S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))) = S (S.mkArr (HomC.set (F y', x')) (HomD.set (y', G x')) (φD (y', G x') o φ y' o ψC (F y', x'))) (S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))" using5 S.comp_mkArr by fastforce ultimatelyshow ?thesis by argo qed moreoverhave2: "S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))) = S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x)))" proof - have "S (Hom_DopxG.map (g, f)) (Φ (y, x)) = S (Φ (y', x')) (Hom_FopxC.map (g, f))" using f g Φ.naturality1 Φ.naturality2 by fastforce moreoverhave"Hom_DopxG.map (g, f) = S.mkArr (HomD.set (y, G x)) (HomD.set (y', G x')) (φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x))" using f g Hom_DopxG_map_simp [of "(g, f)"] by fastforce moreoverhave"Hom_FopxC.map (g, f) = S.mkArr (HomC.set (F y, x)) (HomC.set (F y', x')) (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))" using f g Hom_FopxC_map_simp [of "(g, f)"] by fastforce ultimatelyshow ?thesis using1234by simp qed ultimatelyhave6: "S.arr (S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))))" by fast hence"restrict ((φD (y', G x') o (λh. D (G f) (D h g)) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))) (HomC.set (F y, x)) = S.Fun (S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o (λh. G f ⋅D h ⋅D g) o ψD (y, G x)) o (φD (y, G x) o φ y o ψC (F y, x))))" by simp alsohave"... = S.Fun (S.mkArr (HomC.set (F y, x)) (HomD.set (y', G x')) ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))))" using2by argo alsohave"... = restrict ((φD (y', G x') o φ y' o ψC (F y', x')) o (φC (F y', x') o (λh. f ⋅C h ⋅C F g) o ψC (F y, x))) (HomC.set (F y, x))" using4 S.Fun_mkArr by meson finallyshow ?thesis by auto qed hence5: "((φD (y', G x') ∘ (λh. G f ⋅D h ⋅D g) ∘ ψD (y, G x)) ∘ (φD (y, G x) ∘ φ y ∘ ψC (F y, x))) (φC (F y, x) h) = (φD (y', G x') ∘ φ y' ∘ ψC (F y', x') ∘ (φC (F y', x') ∘ (λh. f ⋅C h ⋅C F g)) ∘ ψC (F y, x)) (φC (F y, x) h)" proof - have"φC (F y, x) h ∈ HomC.set (F y, x)" using x y h HomC.φ_mapsto [of "F y" x] by auto thus ?thesis using0 h restr_eqE [of "(φD (y', G x') ∘ (λh. G f ⋅D h ⋅D g) ∘ ψD (y, G x)) ∘ (φD (y, G x) ∘ φ y ∘ ψC (F y, x))" "HomC.set (F y, x)" "(φD (y', G x') ∘ φ y' ∘ ψC (F y', x')) ∘ (φC (F y', x') ∘ (λh. f ⋅C h ⋅C F g) o ψC (F y, x))"] by fast qed show ?thesis proof - have"φ y' (C f (C h (F g))) = ψD (y', G x') (φD (y', G x') (φ y' (ψC (F y', x') (φC (F y', x') (C f (C (ψC (F y, x) (φC (F y, x) h)) (F g)))))))" proof - have"ψD (y', G x') (φD (y', G x') (φ y' (ψC (F y', x') (φC (F y', x') (C f (C (ψC (F y, x) (φC (F y, x) h)) (F g))))))) = ψD (y', G x') (φD (y', G x') (φ y' (ψC (F y', x') (φC (F y', x') (C f (C h (F g)))))))" using x y h HomC.ψ_φ by simp alsohave"... = ψD (y', G x') (φD (y', G x') (φ y' (C f (C h (F g)))))" using f g h HomC.ψ_φ [of "C f (C h (F g))"] by fastforce alsohave"... = φ y' (C f (C h (F g)))" proof - have"«φ y' (f ⋅C h ⋅C F g) : y' →D G x'¬" using f g h y' x' φ_mapsto [of y' x'] by auto thus ?thesis by simp qed finallyshow ?thesis by auto qed alsohave "... = ψD (y', G x') (φD (y', G x') (G f ⋅D ψD (y, G x) (φD (y, G x) (φ y (ψC (F y, x) (φC (F y, x) h)))) ⋅D g))" using5by force alsohave"... = D (G f) (D (φ y h) g)" proofAOT_have ‹\A([F]u & u ≠E v) ≡\A[λy [F]y & y ='font-size: 18px;'>≠E v]u› have\<phi>yh:"\<guillemotleft>\<phi>yh:y\<rightarrow>\<^sub>DGx\<guillemotright>" usingxyh\<phi>_mapstobyauto have"\<psi>D(y',Gx') (\<phi>D(y',Gx') (Gf\<cdot>\<^sub>D\<psi>D(y,Gx)(\<phi>D(y,Gx)(\<phi>y(\<psi>C(Fy,x)(\<phi>C(Fy,x)h)))) \<cdot>\<^sub>Dg))= \<psi>D(y',Gx')(\<phi>D(y',Gx')(Gf\<cdot>\<^sub>D\<psi>D(y,Gx)(\<phi>D(y,Gx)(\<phi>yh))\<cdot>\<^sub>Dg))" usingxyfghbyauto alsohave"...=\<psi>D(y',Gx')(\<phi>D(y',Gx')(Gf\<cdot>\<^sub>D\<phi>yh\<cdot>\<^sub>Dg))" using\<phi>yhx'y'fgbysimp alsohave"...=Gf\<cdot>\<^sub>D\<phi>yh\<cdot>\<^sub>Dg" using\<phi>yhfgbyfastforce finallyshow?thesisbyauto qed finallyshow?thesisbyauto qed qed qed
(* TODO: This really should show that inverse functors induce an adjoint equivalence. *)
lemma inverse_functors_induce_meta_adjunction: assumes"inverse_functors C D F G" shows"meta_adjunction C D F G (λx. G) (λy. F)" proof - interpret inverse_functors C D F G using assms by auto interpret meta_adjunction C D F G ‹λx. G›‹λy. F› proof - have1: "∧y. B.arr y ==> G (F y) = y" by (metis B.map_simp comp_apply inv) have2: "∧x. A.arr x ==> F (G x) = x" by (metis A.map_simp comp_apply inv') show"meta_adjunction C D F G (λx. G) (λy. F)" proof fix y f x assume y: "B.ide y"and f: "«f : F y →A x¬" show"«G f : y →B G x¬" using y f 1 G.preserves_hom by (elim A.in_homE, auto) show"F (G f) = f" using f 2by auto next fix x g y assume x: "A.ide x"and g: "«g : y →B G x¬" show"«F g : F y →A x¬" using x g 2 F.preserves_hom by (elim B.in_homE, auto) show"G (F g) = g"using g 1 A.map_def by blast next fix f x x' g y' y h assume f: "«f : x →A x'¬"and g: "«g : y' →B y¬"and h: "«h : F y →A x¬" show"G (C f (C h (F g))) = D (G f) (D (G h) g)" using f g h 12 inv inv' A.map_def B.map_def by (elim A.in_homE B.in_homE, auto) qed qed show ?thesis .. qed
lemma inverse_functors_are_adjoints: assumes"inverse_functors A B F G" shows"adjoint_functors A B F G" using assms inverse_functors_induce_meta_adjunction adjoint_functors_def by fast
context inverse_functors begin
lemma η_char: shows"meta_adjunction.η B F (λx. G) = identity_functor.map B" proof (intro natural_transformation_eqI) interpret meta_adjunction A B F G ‹λy. G›‹λx. F› using inverse_functors_induce_meta_adjunction inverse_functors_axioms by auto interpret S: replete_setcat . interpret adjunction A B S.comp S.setp φC φD F G ‹λy. G›‹λx. F› η ε Φ Ψ using induces_adjunction by force show"natural_transformation B B B.map GF.map η" using η.natural_transformation_axioms by auto show"natural_transformation B B B.map GF.map B.map" by (simp add: B.as_nat_trans.natural_transformation_axioms inv) show"∧b. B.ide b ==> η b = B.map b" using η_in_terms_of_φ ηo_def ηo_in_hom by fastforce qed
lemma ε_char: shows"meta_adjunction.ε A F G (λy. F) = identity_functor.map A" proof (intro natural_transformation_eqI) interpret meta_adjunction A B F G ‹λy. G›‹λx. F› using inverse_functors_induce_meta_adjunction inverse_functors_axioms by auto interpret S: replete_setcat . interpret adjunction A B S.comp S.setp φC φD F G ‹λy. G›‹λx. F› η ε Φ Ψ using induces_adjunction by force show"natural_transformation A A FG.map A.map ε" using ε.natural_transformation_axioms by auto show"natural_transformation A A FG.map A.map A.map" by (simp add: A.as_nat_trans.natural_transformation_axioms inv') show"∧a. A.ide a ==> ε a = A.map a" using ε_in_terms_of_ψ εo_def εo_in_hom by fastforce qed
end
section"Composition of Adjunctions"
locale composite_adjunction =
A: category A +
B: category B +
C: category C +
F: "functor" B A F +
G: "functor" A B G +
F': "functor" C B F' +
G': "functor" B C G' +
FG: meta_adjunction A B F G φ ψ +
F'G': meta_adjunction B C F' G' φ' ψ' for A :: "'a comp" (infixr‹⋅A›55) and B :: "'b comp" (infixr‹⋅B›55) and C :: "'c comp" (infixr‹⋅C›55) and F :: "'b ==> 'a" and G :: "'a ==> 'b" and F' :: "'c ==> 'b" and G' :: "'b ==> 'c" and φ :: "'b ==> 'a ==> 'b" and ψ :: "'a ==> 'b ==> 'a" and φ' :: "'c ==> 'b ==> 'c" and ψ' :: "'b ==> 'c ==> 'b" begin
interpretation S: replete_setcat . interpretation FG: adjunction A B S.comp S.setp
FG.φC FG.φD F G φ ψ FG.η FG.ε FG.Φ FG.Ψ using FG.induces_adjunction by simp interpretation F'G': adjunction B C S.comp S.setp F'G'.φC F'G'.φD F' G' φ' ψ'
F'G'.η F'G'.ε F'G'.Φ F'G'.Ψ using F'G'.induces_adjunction by simp
(* Notation for C.in_hom is inherited here somehow, but I don't know from where. *)
lemma is_meta_adjunction: shows"meta_adjunction A C (F o F') (G' o G) (λz. φ' z o φ (F' z)) (λx. ψ x o ψ' (G x))" proof - interpret G'oG: composite_functor A B C G G' .. interpret FoF': composite_functor C B A F' F .. show ?thesis proof fix y f x assume y: "C.ide y"and f: "«f : FoF'.map y →A x¬" show"«(φ' y ∘ φ (F' y)) f : y →C G'oG.map x¬" using y f FG.φ_in_hom F'G'.φ_in_hom by simp show"(ψ x ∘ ψ' (G x)) ((φ' y ∘ φ (F' y)) f) = f" using y f FG.φ_in_hom F'G'.φ_in_hom FG.ψ_φ F'G'.ψ_φ by simp next fix x g y assume x: "A.ide x"and g: "«g : y →C G'oG.map x¬" show"«(ψ x ∘ ψ' (G x)) g : FoF'.map y →A x¬" using x g FG.ψ_in_hom F'G'.ψ_in_hom by auto show"(φ' y ∘ φ (F' y)) ((ψ x ∘ ψ' (G x)) g) = g" using x g FG.ψ_in_hom F'G'.ψ_in_hom FG.φ_ψ F'G'.φ_ψ by simp next fix f x x' g y' y h assume f: "«f : x →A x'¬"and g: "«g : y' →C y¬"and h: "«h : FoF'.map y →A x¬" show"(φ' y' ∘ φ (F' y')) (f ⋅A h ⋅A FoF'.map g) = G'oG.map f ⋅C (φ' y ∘ φ (F' y)) h ⋅C g" using f g h FG.φ_naturality [of f x x' "F' g""F' y'""F' y" h]
F'G'.φ_naturality [of "G f""G x""G x'" g y' y "φ (F' y) h"]
FG.φ_in_hom by fastforce qed qed
interpretation KηH: natural_transformation C C ‹G' o F'›‹G' o G o F o F'› ‹G' o FG.η o F'› proof - interpret ηF': natural_transformation C B F' ‹(G o F) o F'›‹FG.η o F'›
G\etaitytransformationsformation_axioms
horizontal_composite byfastforce interpretF': natural_transformationG' o F'›‹ \<open>G'o(FG.\< using\<eta>F'.natural_transformation_axiomsG'.as_nat_trans.natural_transformation_axioms ontal_compositemposite bysimp:st_all2_refl show"natural_transformationCC(G'oF')(G'oGoFoF')(G'ongrightarrow>P(tnthxs)(tnthysn" eta>F'.natural_transformation_axiomso_assocbymetis qed interpretationG'\<eta>F'"llist_of_tllistapfspof_tllistists Fbytransferauto
theoremtwo_right_adjoints_naturally_isomorphic: assumes"adjoint_functorsCDFG"and"adjoint_functorsCDFG'" shows"naturally_isomorphicCDGG'" proof- text\<open> Foranyobject@{termx}of@{termC},wehavethat\<open>\<epsilon>x\<in>C.hom(F(Gx))x\<close> isaterminalarrowfrom@{termF}to@{termx},andsimilarlyfor\<open>\<epsilon>'x\<close>. Wemaythereforeobtaintheuniquecoextension\<open>\<tau>x\<in>D.hom(Gx)(G'x)\<close> of\<open>\<epsilon>x\<close>along\<open>\<epsilon>'x\<close>. Anexplicitformulafor\<open>\<tau>x\<close>is\<open>D(G'(\<epsilon>x))(\<eta>'(Gx))\<close>. Similarly,weobtain\<open>\<tau>'x=D(G(\<epsilon>'x))(\<eta>(G'x))\<in>D.hom(G'x)(Gx)\<close>. Weshowthesearethecomponentsofinversenaturaltransformationsbetween @{termG}and@{termG'}. \<close> obtain\<phi>\<psi>where\<phi>\<psi>:"meta_adjunctionCDFG\<phi>\<psi>" usingassmsadjoint_functors_defbyblast obtain\<phi>'\<psi>'where\<phi>'\<psi>':"meta_adjunctionCDFG'\<phi>'\<psi>'" usingassmsadjoint_functors_defbyblast interpretAdj:meta_adjunctionCDFG\<phi>\<psi>using\<phi>\<psi>byauto interpretS:replete_setcat. interpretAdj:adjunctionCDS.compS.setpAdj.\<phi>CAdj.\<phi>D FG\<phi>\<psi>Adj.\<eta>Adj.\<epsilon>Adj.\<Phi>Adj.\<Psi> usingAdj.induces_adjunctionbyauto interpretAdj':meta_adjunctionCDFG'\<phi>'\<psi>'using\<phi>'\<psi>'byauto interpretAdj':adjunctionCDS.compS.setpAdj'.\<phi>CAdj'.\<phi>D FG'\<phi>'\<psi>'Adj'.\<eta>Adj'.\<epsilon>Adj'.\<Phi>Adj'.\<Psi> usingAdj'.induces_adjunctionbyauto writeC(infixr\<open>\<cdot>\<^sub>C\<close>55) writeD(infixr\<open>\<cdot>\<^sub>D\<close>55) writeAdj.C.in_hom(\<open>\<guillemotleft>_:_\<rightarrow>\<^sub>C_\<guillemotright>\<close>) writeAdj.D.in_hom(\<open>\<guillemotleft>_:_\<rightarrow>\<^sub>D_\<guillemotright>\<close>) let?\<tau>o="\<lambda>a.G'(Adj.\<epsilon>a)\<cdot>\<^sub>DAdj'.\<eta>(Ga)" interpret\<tau>:transformation_by_componentsCDGG'?\<tau>o proof show"\<And>a.Adj.C.idea\<Longrightarrow>\<guillemotleft>G'(Adj.\<epsilon>a)\<cdot>\<^sub>DAdj'.\<eta>(Ga):Ga\<rightarrow>\<^sub>DG'a\<guillemotright>" byfastforce show"\<And>f.Adj.C.arrf\<Longrightarrow> (G'(Adj.\<epsilon>(Adj.C.codf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.codf)))\<cdot>\<^sub>DGf= G'f\<cdot>\<^sub>DG'(Adj.\<epsilon>(Adj.C.domf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.domf))" proof- fixf assumef:"Adj.C.arrf" let?x="Adj.C.domf" let?x'="Adj.C.codf" have"(G'(Adj.\<epsilon>(Adj.C.codf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.codf)))\<cdot>\<^sub>DGf= G'(Adj.\<epsilon>(Adj.C.codf)\<cdot>\<^sub>CF(Gf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.domf))" usingfAdj'.\<eta>.naturality[of"Gf"]Adj.D.comp_assocbysimp alsohave"...=G'(f\<cdot>\<^sub>CAdj.\<epsilon>(Adj.C.domf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.domf))" usingfAdj.\<epsilon>.naturalitybysimp alsohave"...=G'f\<cdot>\<^sub>DG'(Adj.\<epsilon>(Adj.C.domf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.domf))" usingfAdj.D.comp_assocbysimp finallyshow"(G'(Adj.\<epsilon>(Adj.C.codf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.codf)))\<cdot>\<^sub>DGf= G'f\<cdot>\<^sub>DG'(Adj.\<epsilon>(Adj.C.domf))\<cdot>\<^sub>DAdj'.\<eta>(G(Adj.C.domf))" byauto qed qed interpretnatural_isomorphismCDGG'\<tau>.map proof fixa assumea:"Adj.C.idea" show"Adj.D.iso(\<tau>.mapa)" proof show"Adj.D.inverse_arrows(\<tau>.mapa)(\<phi>(G'a)(Adj'.\<epsilon>a))" proof text\<open> Theproofthatthetwocompositesareidentitiesisamodestdiagramchase. Thisisagoodexampleoftheinferencerulesforthe\<open>category\<close>, \<open>functor\<close>,and\<open>natural_transformation\<close>localesinaction. Isabelleisabletousethesinglehypothesisthat\<open>a\<close>isanidentityto implicitlyfillinallthedetailsthatthevariousquantitiesareinfactarrows andthattheindicatedcompositesareallwell-defined,aswellastoapply associativityofcomposition.Inmostcases,thisisdonebyautoorsimpwithout evenmentioninganyoftherulesthatareused. $$\xymatrix{ {G'a}\ar[dd]_{\eta'(G'a)}\ar[rr]^{\tau'a}\ar[dr]_{\eta(G'a)} &&{Ga}\ar[rr]^{\taua}\ar[dr]_{\eta'(Ga)}&&{G'a}\\ &{GFG'a}\rrtwocell\omit{\omit(2)}\ar[ur]_{G(\epsilon'a)}\ar[dr]_{\eta'(GFG'a)} &&{G'FGa}\drtwocell\omit{\omit(3)}\ar[ur]_{G'(\epsilona)}&\\ {G'FG'a}\urtwocell\omit{\omit(1)}\ar[rr]_{G'F\eta(G'a)}\ar@/_8ex/[rrrr]_{G'FG'a} &&{G'FGFG'a}\dtwocell\omit{\omit(4)}\ar[ru]_{G'FG(\epsilon'a)}\ar[rr]_{G'(\epsilon(FG'a))} &&{G'FG'a}\ar[uu]_{G'(\epsilon'a)}\\ &&&& }$$ \<close> show"Adj.D.ide(\<tau>.mapa\<cdot>\<^sub>D\<phi>(G'a)(Adj'.\<epsilon>a))" proof- have"\<tau>.mapa\<cdot>\<^sub>D\<phi>(G'a)(Adj'.\<epsilon>a)=G'a" proof- have"\<tau>.mapa\<cdot>\<^sub>D\<phi>(G'a)(Adj'.\<epsilon>a)= G'(Adj.\<epsilon>a)\<cdot>\<^sub>D(Adj'.\<eta>(Ga)\<cdot>\<^sub>DG(Adj'.\<epsilon>a))\<cdot>\<^sub>DAdj.\<eta>(G'a)" usinga\<tau>.map_simp_ideAdj.\<phi>_in_terms_of_\<eta>Adj'.\<phi>_in_terms_of_\<eta> Adj'.\<epsilon>.preserves_hom[ofaaa]Adj.C.ide_in_homAdj.D.comp_assoc Adj.\<epsilon>_defAdj.\<eta>_def bysimp alsohave"...=G'(Adj.\<epsilon>a)\<cdot>\<^sub>D(G'(F(G(Adj'.\<epsilon>a)))\<cdot>\<^sub>DAdj'.\<eta>(G(F(G'a))))\<cdot>\<^sub>D Adj.\<eta>(G'a)" usingaAdj'.\<eta>.naturality[of"G(Adj'.\<epsilon>a)"]byauto alsohave"...=(G'(Adj.\<epsilon>a)\<cdot>\<^sub>DG'(F(G(Adj'.\<epsilon>a))))\<cdot>\<^sub>DG'(F(Adj.\<eta>(G'a)))\<cdot>\<^sub>D Adj'.\<eta>(G'a)" usingaAdj'.\<eta>.naturality[of"Adj.\<eta>(G'a)"]Adj.D.comp_assocbyauto alsohave "...=G'(Adj'.\<epsilon>a)\<cdot>\<^sub>D(G'(Adj.\<epsilon>(F(G'a)))\<cdot>\<^sub>DG'(F(Adj.\<eta>(G'a))))\<cdot>\<^sub>D Adj'.\<eta>(G'a)" proof- have "G'(Adj.\<epsilon>a)\<cdot>\<^sub>DG'(F(G(Adj'.\<epsilon>a)))=G'(Adj'.\<epsilon>a)\<cdot>\<^sub>DG'(Adj.\<epsilon>(F(G'a)))" proof- have"G'(Adj.\<epsilon>a\<cdot>\<^sub>CF(G(Adj'.\<epsilon>a)))=G'(Adj'.\<epsilon>a\<cdot>\<^sub>CAdj.\<epsilon>(F(G'a)))" usingaAdj.\<epsilon>.naturality[of"Adj'.\<epsilon>a"]byauto thus?thesisusingabyforce qed thus?thesisusingAdj.D.comp_assocbyauto qed alsohave"...=G'(Adj'.\<epsilon>a)\<cdot>\<^sub>DAdj'.\<eta>(G'a)" proof- have"G'(Adj.\<epsilon>(F(G'a)))\<cdot>\<^sub>DG'(F(Adj.\<eta>(G'a)))=G'(F(G'a))" proof- have "G'(Adj.\<epsilon>(F(G'a)))\<cdot>\<^sub>DG'(F(Adj.\<eta>(G'a)))=G'(Adj.\<epsilon>FoF\<eta>.map(G'a))" usingaAdj.\<epsilon>FoF\<eta>.map_simp_1byauto moreoverhave"Adj.\<epsilon>FoF\<eta>.map(G'a)=F(G'a)" usingaby(simpadd:Adj.\<eta>\<epsilon>.triangle_F) ultimatelyshow?thesisbyauto qed thus?thesis usingaAdj.D.comp_cod_arr[of"Adj'.\<eta>(G'a)"]byauto qed alsohave"...=G'a" usingaAdj'.\<eta>\<epsilon>.triangle_GAdj'.G\<epsilon>o\<eta>G.map_simp_1[ofa]byauto finallyshow?thesisbyauto qed thus?thesisusingabysimp qed show"Adj.D.ide(\<phi>(G'a)(Adj'.\<epsilon>a)\<cdot>\<^sub>D\<tau>.mapa)" proof- have"\<phi>(G'a)(Adj'.\<epsilon>a)\<cdot>\<^sub>D\<tau>.mapa=Ga" proof- have"\<phi>(G'a)(Adj'.\<epsilon>a)\<cdot>\<^sub>D\<tau>.mapa= G(Adj'.\<epsilon>a)\<cdot>\<^sub>D(Adj.\<eta>(G'a)\<cdot>\<^sub>DG'(Adj.\<epsilon>a))\<cdot>\<^sub>DAdj'.\<eta>(Ga)" usinga\<tau>.map_simp_ideAdj.\<phi>_in_terms_of_\<eta>Adj'.\<epsilon>.preserves_hom[ofaaa] Adj.C.ide_in_homAdj.D.comp_assocAdj.\<eta>_def byauto alsohave "...=G(Adj'.\<epsilon>a)\<cdot>\<^sub>D(G(F(G'(Adj.\<epsilon>a)))\<cdot>\<^sub>DAdj.\<eta>(G'(F(Ga))))\<cdot>\<^sub>D Adj'.\<eta>(Ga)" usingaAdj.\<eta>.naturality[of"G'(Adj.\<epsilon>a)"]byauto alsohave "...=(G(Adj'.\<epsilon>a)\<cdot>\<^sub>DG(F(G'(Adj.\<epsilon>a))))\<cdot>\<^sub>DG(F(Adj'.\<eta>(Ga)))\<cdot>\<^sub>D Adj.\<eta>(Ga)" usingaAdj.\<eta>.naturality[of"Adj'.\<eta>(Ga)"]Adj.D.comp_assocbyauto alsohave "...=G(Adj.\<epsilon>a)\<cdot>\<^sub>D(G(Adj'.\<epsilon>(F(Ga)))\<cdot>\<^sub>DG(F(Adj'.\<eta>(Ga))))\<cdot>\<^sub>D Adj.\<eta>(Ga)" proof- have"G(Adj'.\<epsilon>a)\<cdot>\<^sub>DG(F(G'(Adj.\<epsilon>a)))=G(Adj.\<epsilon>a)\<cdot>\<^sub>DG(Adj'.\<epsilon>(F(Ga)))" proof- have"G(Adj'.\<epsilon>a\<cdot>\<^sub>CF(G'(Adj.\<epsilon>a)))=G(Adj.\<epsilon>a\<cdot>\<^sub>CAdj'.\<epsilon>(F(Ga)))" usingaAdj'.\<epsilon>.naturality[of"Adj.\<epsilon>a"]byauto thus?thesisusingabyforce qed thus?thesisusingAdj.D.comp_assocbyauto qed alsohave"...=G(Adj.\<epsilon>a)\<cdot>\<^sub>DAdj.\<eta>(Ga)" proof- have"G(Adj'.\<epsilon>(F(Ga)))\<cdot>\<^sub>DG(F(Adj'.\<eta>(Ga)))=G(F(Ga))" proof- have "G(Adj'.\<epsilon>(F(Ga)))\<cdot>\<^sub>DG(F(Adj'.\<eta>(Ga)))=G(Adj'.\<epsilon>FoF\<eta>.map(Ga))" usingaAdj'.\<epsilon>FoF\<eta>.map_simp_1[of"Ga"]byauto moreoverhave"Adj'.\<epsilon>FoF\<eta>.map(Ga)=F(Ga)" usingaby(simpadd:Adj'.\<eta>\<epsilon>.triangle_F) ultimatelyshow?thesisbyauto qed thus?thesis usingaAdj.D.comp_cod_arrbyauto qed alsohave"...=Ga" usingaAdj.\<eta>\<epsilon>.triangle_GAdj.G\<epsilon>o\<eta>G.map_simp_1[ofa]byauto finallyshow?thesisbyauto qed thus?thesisusingabyauto qed qed qed qed have"natural_isomorphismCDGG'\<tau>.map".. thus"naturally_isomorphicCDGG'" usingnaturally_isomorphic_defbyblast qed
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.346Bemerkung:
(vorverarbeitet am 2026-06-10)
¤
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.
