Theory CZH_ECAT_Yoneda
section‹Yoneda Lemma›
theory CZH_ECAT_Yoneda
imports
CZH_ECAT_FUNCT
CZH_ECAT_Hom
begin
subsection‹Yoneda map›
text‹
The Yoneda map is the bijection that is used in the statement of the
Yoneda Lemma, as presented, for example, in Chapter III-2 in
\<^cite>‹"mac_lane_categories_2010"› or in subsection 1.15
in \<^cite>‹"bodo_categories_1970"›.
›
definition Yoneda_map :: "V ⇒ V ⇒ V ⇒ V"
where "Yoneda_map α 𝔎 r =
(
λψ∈⇩∘these_ntcfs α (𝔎⦇HomDom⦈) (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙𝔎⦇HomDom⦈(r,-) 𝔎.
ψ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔎⦇HomDom⦈⦇CId⦈⦇r⦈⦈
)"
text‹Elementary properties.›
mk_VLambda Yoneda_map_def
|vsv Yoneda_map_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) Yoneda_map_def[where α=α and 𝔎=𝔉, unfolded cf_HomDom]
|vdomain Yoneda_map_vdomain|
|app Yoneda_map_app[unfolded these_ntcfs_iff]|
lemmas [cat_cs_simps] = is_functor.Yoneda_map_vdomain
lemmas Yoneda_map_app[cat_cs_simps] =
is_functor.Yoneda_map_app[unfolded these_ntcfs_iff]
subsection‹Yoneda component›
subsubsection‹Definition and elementary properties›
text‹
The Yoneda components are the components of the natural transformations
that appear in the statement of the Yoneda Lemma (e.g., see
Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"› or subsection 1.15
in \<^cite>‹"bodo_categories_1970"›).
›
definition Yoneda_component :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "Yoneda_component 𝔎 r u d =
[
(λf∈⇩∘Hom (𝔎⦇HomDom⦈) r d. 𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈),
Hom (𝔎⦇HomDom⦈) r d,
𝔎⦇ObjMap⦈⦇d⦈
]⇩∘"
text‹Components.›
lemma (in is_functor) Yoneda_component_components:
shows "Yoneda_component 𝔉 r u d⦇ArrVal⦈ =
(λf∈⇩∘Hom 𝔄 r d. 𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈)"
and "Yoneda_component 𝔉 r u d⦇ArrDom⦈ = Hom 𝔄 r d"
and "Yoneda_component 𝔉 r u d⦇ArrCod⦈ = 𝔉⦇ObjMap⦈⦇d⦈"
unfolding Yoneda_component_def arr_field_simps
by (simp_all add: nat_omega_simps cat_cs_simps)
subsubsection‹Arrow value›
mk_VLambda (in is_functor) Yoneda_component_components(1)
|vsv Yoneda_component_ArrVal_vsv|
|vdomain Yoneda_component_ArrVal_vdomain|
|app Yoneda_component_ArrVal_app[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] = is_functor.Yoneda_component_ArrVal_vdomain
lemmas Yoneda_component_ArrVal_app[cat_cs_simps] =
is_functor.Yoneda_component_ArrVal_app[unfolded in_Hom_iff]
subsubsection‹Yoneda component is an arrow in the category ‹Set››
lemma (in category) cat_Yoneda_component_is_arr:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
and "u ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
and "d ∈⇩∘ ℭ⦇Obj⦈"
shows "Yoneda_component 𝔎 r u d : Hom ℭ r d ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇d⦈"
proof-
interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1))
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI, unfold 𝔎.Yoneda_component_components)
show "vfsequence (Yoneda_component 𝔎 r u d)"
unfolding Yoneda_component_def by simp
show "vcard (Yoneda_component 𝔎 r u d) = 3⇩ℕ"
unfolding Yoneda_component_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (λf∈⇩∘Hom ℭ r d. 𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈) ⊆⇩∘ 𝔎⦇ObjMap⦈⦇d⦈"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ∈⇩∘ Hom ℭ r d"
then have 𝔎f: "𝔎⦇ArrMap⦈⦇f⦈ : 𝔎⦇ObjMap⦈⦇r⦈ ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇d⦈"
by (auto simp: cat_cs_intros)
note 𝔎f_simps = cat_Set_is_arrD[OF 𝔎f]
interpret 𝔎f: arr_Set α ‹𝔎⦇ArrMap⦈⦇f⦈› by (rule 𝔎f_simps(1))
have "u ∈⇩∘ 𝒟⇩∘ (𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈)"
by (simp add: 𝔎f_simps assms cat_Set_cs_simps)
with 𝔎f.arr_Set_ArrVal_vrange[unfolded 𝔎f_simps] show
"𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈ ∈⇩∘ 𝔎⦇ObjMap⦈⦇d⦈"
by (blast elim: 𝔎f.ArrVal.vsv_value)
qed
from assms 𝔎.HomCod.cat_Obj_vsubset_Vset show "𝔎⦇ObjMap⦈⦇d⦈ ∈⇩∘ Vset α"
by (auto dest: 𝔎.cf_ObjMap_app_in_HomCod_Obj)
qed (auto simp: assms cat_cs_intros)
qed
lemma (in category) cat_Yoneda_component_is_arr':
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
and "u ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
and "d ∈⇩∘ ℭ⦇Obj⦈"
and "s = Hom ℭ r d"
and "t = 𝔎⦇ObjMap⦈⦇d⦈"
and "𝔇 = cat_Set α"
shows "Yoneda_component 𝔎 r u d : s ↦⇘𝔇⇙ t"
unfolding assms(5-7) using assms(1-4) by (rule cat_Yoneda_component_is_arr)
lemmas [cat_cs_intros] = category.cat_Yoneda_component_is_arr'[rotated 1]
subsection‹Yoneda arrow›
subsubsection‹Definition and elementary properties›
text‹
The Yoneda arrows are the natural transformations that
appear in the statement of the Yoneda Lemma in Chapter III-2 in
\<^cite>‹"mac_lane_categories_2010"› and subsection 1.15
in \<^cite>‹"bodo_categories_1970"›.
›
definition Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "Yoneda_arrow α 𝔎 r u =
[
(λd∈⇩∘𝔎⦇HomDom⦈⦇Obj⦈. Yoneda_component 𝔎 r u d),
Hom⇩O⇩.⇩C⇘α⇙𝔎⦇HomDom⦈(r,-),
𝔎,
𝔎⦇HomDom⦈,
cat_Set α
]⇩∘"
text‹Components.›
lemma (in is_functor) Yoneda_arrow_components:
shows "Yoneda_arrow α 𝔉 r u⦇NTMap⦈ =
(λd∈⇩∘𝔄⦇Obj⦈. Yoneda_component 𝔉 r u d)"
and "Yoneda_arrow α 𝔉 r u⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)"
and "Yoneda_arrow α 𝔉 r u⦇NTCod⦈ = 𝔉"
and "Yoneda_arrow α 𝔉 r u⦇NTDGDom⦈ = 𝔄"
and "Yoneda_arrow α 𝔉 r u⦇NTDGCod⦈ = cat_Set α"
unfolding Yoneda_arrow_def nt_field_simps
by (simp_all add: nat_omega_simps cat_cs_simps)
subsubsection‹Natural transformation map›
mk_VLambda (in is_functor) Yoneda_arrow_components(1)
|vsv Yoneda_arrow_NTMap_vsv|
|vdomain Yoneda_arrow_NTMap_vdomain|
|app Yoneda_arrow_NTMap_app|
lemmas [cat_cs_simps] = is_functor.Yoneda_arrow_NTMap_vdomain
lemmas Yoneda_arrow_NTMap_app[cat_cs_simps] =
is_functor.Yoneda_arrow_NTMap_app
subsubsection‹Yoneda arrow is a natural transformation›
lemma (in category) cat_Yoneda_arrow_is_ntcf:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
and "u ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
shows "Yoneda_arrow α 𝔎 r u : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F 𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1))
note 𝔎ru = cat_Yoneda_component_is_arr[OF assms]
let ?𝔎ru = ‹Yoneda_component 𝔎 r u›
show ?thesis
proof(intro is_ntcfI', unfold 𝔎.Yoneda_arrow_components)
show "vfsequence (Yoneda_arrow α 𝔎 r u)"
unfolding Yoneda_arrow_def by simp
show "vcard (Yoneda_arrow α 𝔎 r u) = 5⇩ℕ"
unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)
show
"(λd∈⇩∘ℭ⦇Obj⦈. ?𝔎ru d)⦇a⦈ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using that assms category_axioms
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps V_cs_simps
cs_intro: cat_cs_intros
)
show
"(λd∈⇩∘ℭ⦇Obj⦈. ?𝔎ru d)⦇b⦈ ∘⇩A⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈ =
𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ (λd∈⇩∘ℭ⦇Obj⦈. ?𝔎ru d)⦇a⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
proof-
note 𝔐a = 𝔎ru[OF cat_is_arrD(2)[OF that]]
note 𝔐b = 𝔎ru[OF cat_is_arrD(3)[OF that]]
from category_axioms assms that 𝔐b have b_f:
"?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘ :
Hom ℭ r a ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by
(
cs_concl cs_shallow
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"𝒟⇩∘ ((?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘)⦇ArrVal⦈) =
Hom ℭ r a"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from assms that 𝔐a have f_a:
"𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a :
Hom ℭ r a ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by (cs_concl cs_shallow cs_intro: cat_cs_intros)
then have dom_rhs:
"𝒟⇩∘ ((𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈) = Hom ℭ r a"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
have [cat_cs_simps]:
"?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘ =
𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a"
proof(rule arr_Set_eqI[of α])
from b_f show arr_Set_b_f:
"arr_Set α (?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘)"
by (auto simp: cat_Set_is_arrD(1))
interpret b_f: arr_Set α ‹?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘›
by (rule arr_Set_b_f)
from f_a show arr_Set_f_a:
"arr_Set α (𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a)"
by (auto simp: cat_Set_is_arrD(1))
interpret f_a: arr_Set α ‹𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a›
by (rule arr_Set_f_a)
show
"(?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘)⦇ArrVal⦈ =
(𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix q assume "q : r ↦⇘ℭ⇙ a"
from category_axioms assms that this 𝔐a 𝔐b show
"(?𝔎ru b ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]⇩∘)⦇ArrVal⦈⦇q⦈ =
(𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈⦇q⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_b_f arr_Set_f_a in auto)
qed (use b_f f_a in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
from that category_axioms assms 𝔐a 𝔐b show ?thesis
by
(
cs_concl
cs_simp: V_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
qed
qed (auto simp: assms(2) cat_cs_intros)
qed
subsection‹Yoneda Lemma›
text‹
The following lemma is approximately equivalent to the Yoneda Lemma
stated in subsection 1.15 in \<^cite>‹"bodo_categories_1970"›
(the first two conclusions correspond to the statement of the
Yoneda lemma in Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›).
›
lemma (in category) cat_Yoneda_Lemma:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "v11 (Yoneda_map α 𝔎 r)"
and "ℛ⇩∘ (Yoneda_map α 𝔎 r) = 𝔎⦇ObjMap⦈⦇r⦈"
and "(Yoneda_map α 𝔎 r)¯⇩∘ = (λu∈⇩∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)"
proof-
interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1))
from assms(2) 𝔎.HomCod.cat_Obj_vsubset_Vset 𝔎.cf_ObjMap_app_in_HomCod_Obj
have 𝔎r_in_Vset: "𝔎⦇ObjMap⦈⦇r⦈ ∈⇩∘ Vset α"
by auto
show Ym: "v11 (Yoneda_map α 𝔎 r)"
proof(intro vsv.vsv_valeq_v11I, unfold 𝔎.Yoneda_map_vdomain these_ntcfs_iff)
fix 𝔐 𝔑
assume prems:
"𝔐 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F 𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
"𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F 𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
"Yoneda_map α 𝔎 r⦇𝔐⦈ = Yoneda_map α 𝔎 r⦇𝔑⦈"
from prems(3) have 𝔐r_𝔑r:
"𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ = 𝔑⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
unfolding
Yoneda_map_app[OF assms(1) prems(1)]
Yoneda_map_app[OF assms(1) prems(2)]
by simp
interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)› 𝔎 𝔐
by (rule prems(1))
interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)› 𝔎 𝔑
by (rule prems(2))
show "𝔐 = 𝔑"
proof
(
rule ntcf_eqI[OF prems(1,2)];
(rule refl)?;
rule vsv_eqI,
unfold 𝔐.ntcf_NTMap_vdomain 𝔑.ntcf_NTMap_vdomain
)
fix d assume prems': "d ∈⇩∘ ℭ⦇Obj⦈"
note 𝔐d_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF prems']]
interpret 𝔐d: arr_Set α ‹𝔐⦇NTMap⦈⦇d⦈› by (rule 𝔐d_simps(1))
note 𝔑d_simps = cat_Set_is_arrD[OF 𝔑.ntcf_NTMap_is_arr[OF prems']]
interpret 𝔑d: arr_Set α ‹𝔑⦇NTMap⦈⦇d⦈› by (rule 𝔑d_simps(1))
show "𝔐⦇NTMap⦈⦇d⦈ = 𝔑⦇NTMap⦈⦇d⦈"
proof(rule arr_Set_eqI[of α])
show "𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈ = 𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈"
proof
(
rule vsv_eqI,
unfold
𝔑d.arr_Set_ArrVal_vdomain
𝔐d.arr_Set_ArrVal_vdomain
𝔐d_simps
𝔑d_simps
)
fix f assume prems'': "f ∈⇩∘ Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)⦇ObjMap⦈⦇d⦈"
from prems'' prems' category_axioms assms(2) have f: "f : r ↦⇘ℭ⇙ d"
by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_op_intros)
from 𝔐.ntcf_Comp_commute[OF f] have
"(
𝔐⦇NTMap⦈⦇d⦈ ∘⇩A⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈
)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ =
(𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ 𝔐⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
by simp
from this category_axioms assms(2) f prems prems' have 𝔐df:
"𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ =
𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈⦈"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from 𝔑.ntcf_Comp_commute[OF f] have
"(
𝔑⦇NTMap⦈⦇d⦈ ∘⇩A⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈
)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ =
(𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ 𝔑⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
by simp
from this category_axioms assms(2) f prems prems' have 𝔑df:
"𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ =
𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈⦈"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
show "𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ = 𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈"
unfolding 𝔐df 𝔑df 𝔐r_𝔑r by simp
qed auto
qed (simp_all add: 𝔐d_simps 𝔑d_simps)
qed auto
qed (auto simp: Yoneda_map_vsv)
interpret Ym: v11 ‹Yoneda_map α 𝔎 r› by (rule Ym)
have YY: "Yoneda_map α 𝔎 r⦇Yoneda_arrow α 𝔎 r a⦈ = a"
if "a ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈" for a
proof-
note cat_Yoneda_arrow_is_ntcf[OF assms that]
moreover with assms have Ya: "Yoneda_arrow α 𝔎 r a ∈⇩∘ 𝒟⇩∘ (Yoneda_map α 𝔎 r)"
by
(
cs_concl cs_shallow
cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
)
ultimately show "Yoneda_map α 𝔎 r⦇Yoneda_arrow α 𝔎 r a⦈ = a"
using assms that 𝔎r_in_Vset
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
show [simp]: "ℛ⇩∘ (Yoneda_map α 𝔎 r) = 𝔎⦇ObjMap⦈⦇r⦈"
proof(intro vsubset_antisym)
show "ℛ⇩∘ (Yoneda_map α 𝔎 r) ⊆⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
unfolding Yoneda_map_def
proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff 𝔎.cf_HomDom)
fix 𝔐 assume prems: "𝔐 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F 𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
then interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)› 𝔎 𝔐 .
note 𝔐r_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF assms(2)]]
interpret 𝔐r: arr_Set α ‹𝔐⦇NTMap⦈⦇r⦈› by (rule 𝔐r_simps(1))
from prems category_axioms assms(2) have
"ℭ⦇CId⦈⦇r⦈ ∈⇩∘ 𝒟⇩∘ (𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈)"
unfolding 𝔐r.arr_Set_ArrVal_vdomain 𝔐r_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
then have "𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ ∈⇩∘ ℛ⇩∘ (𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈)"
by (blast elim: 𝔐r.ArrVal.vsv_value)
then show "𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
by (auto simp: 𝔐r_simps dest!: vsubsetD[OF 𝔐r.arr_Set_ArrVal_vrange])
qed
show "𝔎⦇ObjMap⦈⦇r⦈ ⊆⇩∘ ℛ⇩∘ (Yoneda_map α 𝔎 r)"
proof(intro vsubsetI)
fix u assume prems: "u ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
from cat_Yoneda_arrow_is_ntcf[OF assms prems] have
"Yoneda_arrow α 𝔎 r u ∈⇩∘ 𝒟⇩∘ (Yoneda_map α 𝔎 r)"
by
(
cs_concl cs_shallow
cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
)
with YY[OF prems] show "u ∈⇩∘ ℛ⇩∘ (Yoneda_map α 𝔎 r)"
by (force dest!: vdomain_atD)
qed
qed
show "(Yoneda_map α 𝔎 r)¯⇩∘ = (λu∈⇩∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)"
proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
from Ym show "vsv ((Yoneda_map α 𝔎 r)¯⇩∘)" by auto
show "(Yoneda_map α 𝔎 r)¯⇩∘⦇a⦈ = (λu∈⇩∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)⦇a⦈"
if "a ∈⇩∘ ℛ⇩∘ (Yoneda_map α 𝔎 r)" for a
proof-
from that have a: "a ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈" by simp
note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
then have "Yoneda_arrow α 𝔎 r a ∈⇩∘ 𝒟⇩∘ (Yoneda_map α 𝔎 r)"
by
(
cs_concl cs_shallow
cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
)
with Ya YY[OF a] a show ?thesis
by
(
intro Ym.v11_vconverse_app[
unfolded 𝔎.Yoneda_map_vdomain these_ntcfs_iff
]
)
(simp_all add: these_ntcfs_iff cat_cs_simps)
qed
qed auto
qed
subsection‹Inverse of the Yoneda map›
lemma (in category) inv_Yoneda_map_v11:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "v11 ((Yoneda_map α 𝔎 r)¯⇩∘)"
using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_Yoneda_map_vdomain:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "𝒟⇩∘ ((Yoneda_map α 𝔎 r)¯⇩∘) = 𝔎⦇ObjMap⦈⦇r⦈"
unfolding cat_Yoneda_Lemma(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_Yoneda_map_vdomain
lemma (in category) inv_Yoneda_map_app:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "r ∈⇩∘ ℭ⦇Obj⦈" and "u ∈⇩∘ 𝔎⦇ObjMap⦈⦇r⦈"
shows "(Yoneda_map α 𝔎 r)¯⇩∘⦇u⦈ = Yoneda_arrow α 𝔎 r u"
using assms(3) unfolding cat_Yoneda_Lemma(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_Yoneda_map_app
lemma (in category) inv_Yoneda_map_vrange:
assumes "𝔎 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "ℛ⇩∘ ((Yoneda_map α 𝔎 r)¯⇩∘) =
these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) 𝔎"
proof-
interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1))
show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
qed
subsection‹
Component of a composition of a ‹Hom›-natural transformation
with natural transformations
›
subsubsection‹Definition and elementary properties›
text‹
The following definition is merely a technical generalization
that is used in the context of the description of the
composition of a ‹Hom›-natural transformation with a natural transformation
later in this section
(also see subsection 1.15 in \<^cite>‹"bodo_categories_1970"›).
›
definition ntcf_Hom_component :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_Hom_component φ ψ a b =
[
(
λf∈⇩∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈).
ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ψ⦇NTDGCod⦈⇙ f ∘⇩A⇘ψ⦇NTDGCod⦈⇙ φ⦇NTMap⦈⦇a⦈
),
Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈),
Hom (φ⦇NTDGCod⦈) (φ⦇NTDom⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTCod⦈⦇ObjMap⦈⦇b⦈)
]⇩∘"
text‹Components.›
lemma ntcf_Hom_component_components:
shows "ntcf_Hom_component φ ψ a b⦇ArrVal⦈ =
(
λf∈⇩∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈).
ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ψ⦇NTDGCod⦈⇙ f ∘⇩A⇘ψ⦇NTDGCod⦈⇙ φ⦇NTMap⦈⦇a⦈
)"
and "ntcf_Hom_component φ ψ a b⦇ArrDom⦈ =
Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈)"
and "ntcf_Hom_component φ ψ a b⦇ArrCod⦈ =
Hom (φ⦇NTDGCod⦈) (φ⦇NTDom⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTCod⦈⦇ObjMap⦈⦇b⦈)"
unfolding ntcf_Hom_component_def arr_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Arrow value›
mk_VLambda ntcf_Hom_component_components(1)
|vsv ntcf_Hom_component_ArrVal_vsv[intro]|
context
fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
assumes φ: "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and ψ: "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)
mk_VLambda
ntcf_Hom_component_components(1)
[
of φ ψ,
unfolded
φ.ntcf_NTDom ψ.ntcf_NTDom
φ.ntcf_NTCod ψ.ntcf_NTCod
φ.ntcf_NTDGDom ψ.ntcf_NTDGDom
φ.ntcf_NTDGCod ψ.ntcf_NTDGCod
]
|vdomain ntcf_Hom_component_ArrVal_vdomain|
|app ntcf_Hom_component_ArrVal_app[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] =
ntcf_Hom_component_ArrVal_vdomain
ntcf_Hom_component_ArrVal_app
lemma ntcf_Hom_component_ArrVal_vrange:
assumes "a ∈⇩∘ 𝔄⦇Obj⦈" and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows
"ℛ⇩∘ (ntcf_Hom_component φ ψ a b⦇ArrVal⦈) ⊆⇩∘
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
)
fix f assume "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
with assms φ ψ show
"ntcf_Hom_component φ ψ a b⦇ArrVal⦈⦇f⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔊'⦇ObjMap⦈⦇b⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (rule ntcf_Hom_component_ArrVal_vsv)
end
subsubsection‹Arrow domain and codomain›
context
fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
assumes φ: "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and ψ: "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)
lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
"ntcf_Hom_component φ ψ a b⦇ArrDom⦈ = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
"ntcf_Hom_component φ ψ a b⦇ArrCod⦈ = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
end
subsubsection‹
Component of a composition of a ‹Hom›-natural transformation
with natural transformations is an arrow in the category ‹Set›
›
lemma (in category) cat_ntcf_Hom_component_is_arr:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows
"ntcf_Hom_component φ ψ a b :
Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
from assms have a: "a ∈⇩∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (ntcf_Hom_component φ ψ a b)"
unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
show "vcard (ntcf_Hom_component φ ψ a b) = 3⇩ℕ"
unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
from assms ntcf_Hom_component_ArrVal_vrange[OF assms(1,2) a assms(4)] show
"ℛ⇩∘ (ntcf_Hom_component φ ψ a b⦇ArrVal⦈) ⊆⇩∘
ntcf_Hom_component φ ψ a b⦇ArrCod⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from assms(1,2,4) a show "ntcf_Hom_component φ ψ a b⦇ArrDom⦈ ∈⇩∘ Vset α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(1,2,4) a show "ntcf_Hom_component φ ψ a b⦇ArrCod⦈ ∈⇩∘ Vset α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use assms in ‹auto simp: ntcf_Hom_component_components cat_cs_simps›)
qed
lemma (in category) cat_ntcf_Hom_component_is_arr':
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
and "𝔄' = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
and "𝔅' = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
and "ℭ' = cat_Set α"
shows "ntcf_Hom_component φ ψ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
using assms(1-4) unfolding assms(5-7) by (rule cat_ntcf_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_component_is_arr'
subsubsection‹
Naturality of the components of a composition of
a ‹Hom›-natural transformation with natural transformations
›
lemma (in category) cat_ntcf_Hom_component_nat:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "g : a ↦⇘op_cat 𝔄⇙ a'"
and "f : b ↦⇘𝔅⇙ b'"
shows
"ntcf_Hom_component φ ψ a' b' ∘⇩A⇘cat_Set α⇙
cf_hom ℭ [𝔊⦇ArrMap⦈⦇g⦈, 𝔉'⦇ArrMap⦈⦇f⦈]⇩∘ =
cf_hom ℭ [𝔉⦇ArrMap⦈⦇g⦈, 𝔊'⦇ArrMap⦈⦇f⦈]⇩∘ ∘⇩A⇘cat_Set α⇙
ntcf_Hom_component φ ψ a b"
proof-
let ?Y_ab = ‹ntcf_Hom_component φ ψ a b›
and ?Y_a'b' = ‹ntcf_Hom_component φ ψ a' b'›
and ?𝔊g = ‹𝔊⦇ArrMap⦈⦇g⦈›
and ?𝔉'f = ‹𝔉'⦇ArrMap⦈⦇f⦈›
and ?𝔉g = ‹𝔉⦇ArrMap⦈⦇g⦈›
and ?𝔊'f = ‹𝔊'⦇ArrMap⦈⦇f⦈›
and ?𝔊a = ‹𝔊⦇ObjMap⦈⦇a⦈›
and ?𝔉'b = ‹𝔉'⦇ObjMap⦈⦇b⦈›
and ?𝔉a' = ‹𝔉⦇ObjMap⦈⦇a'⦈›
and ?𝔊'b' = ‹𝔊'⦇ObjMap⦈⦇b'⦈›
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
from assms(3) have g: "g : a' ↦⇘𝔄⇙ a" unfolding cat_op_simps by simp
from Set.category_axioms category_axioms assms g have a'b_Gg𝔉'f:
"?Y_a'b' ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]⇩∘ :
Hom ℭ ?𝔊a ?𝔉'b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a' ?𝔊'b'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"𝒟⇩∘ ((?Y_a'b' ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]⇩∘)⦇ArrVal⦈) =
Hom ℭ ?𝔊a ?𝔉'b"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from Set.category_axioms category_axioms assms g have 𝔉g𝔊'f_ab:
"cf_hom ℭ [?𝔉g, ?𝔊'f]⇩∘ ∘⇩A⇘cat_Set α⇙ ?Y_ab :
Hom ℭ ?𝔊a ?𝔉'b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a' ?𝔊'b'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ ((cf_hom ℭ [?𝔉g, ?𝔊'f]⇩∘ ∘⇩A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈) =
Hom ℭ ?𝔊a ?𝔉'b"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from a'b_Gg𝔉'f show arr_Set_a'b_Gg𝔉'f:
"arr_Set α (?Y_a'b' ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]⇩∘)"
by (auto dest: cat_Set_is_arrD(1))
from 𝔉g𝔊'f_ab show arr_Set_𝔉g𝔊'f_ab:
"arr_Set α (cf_hom ℭ [?𝔉g, ?𝔊'f]⇩∘ ∘⇩A⇘cat_Set α⇙ ?Y_ab)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?Y_a'b' ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]⇩∘)⦇ArrVal⦈ =
(cf_hom ℭ [?𝔉g, ?𝔊'f]⇩∘ ∘⇩A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume prems: "h : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
from assms(1,2) g have [cat_cs_simps]:
"ψ⦇NTMap⦈⦇b'⦈ ∘⇩A⇘ℭ⇙ (?𝔉'f ∘⇩A⇘ℭ⇙ (h ∘⇩A⇘ℭ⇙ (?𝔊g ∘⇩A⇘ℭ⇙ φ⦇NTMap⦈⦇a'⦈))) =
ψ⦇NTMap⦈⦇b'⦈ ∘⇩A⇘ℭ⇙ (?𝔉'f ∘⇩A⇘ℭ⇙ (h ∘⇩A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ ?𝔉g)))"
by
(
cs_concl cs_shallow
cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros
)
also from assms(1,2,4) prems g have "… =
(((ψ⦇NTMap⦈⦇b'⦈ ∘⇩A⇘ℭ⇙ ?𝔉'f) ∘⇩A⇘ℭ⇙ h) ∘⇩A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈) ∘⇩A⇘ℭ⇙ ?𝔉g"
by (cs_concl cs_shallow cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros)
also from assms(1,2,4) have "… =
(((?𝔊'f ∘⇩A⇘ℭ⇙ ψ⦇NTMap⦈⦇b⦈) ∘⇩A⇘ℭ⇙ h) ∘⇩A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈) ∘⇩A⇘ℭ⇙ ?𝔉g"
by
(
cs_concl cs_shallow
cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros
)
also from assms(1,2,4) prems g have "… =
?𝔊'f ∘⇩A⇘ℭ⇙ (ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ (h ∘⇩A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ ?𝔉g)))"
by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros)
finally have nat:
"ψ⦇NTMap⦈⦇b'⦈ ∘⇩A⇘ℭ⇙ (?𝔉'f ∘⇩A⇘ℭ⇙ (h ∘⇩A⇘ℭ⇙ (?𝔊g ∘⇩A⇘ℭ⇙ φ⦇NTMap⦈⦇a'⦈))) =
?𝔊'f ∘⇩A⇘ℭ⇙ (ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ (h ∘⇩A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ ?𝔉g)))".
from prems Set.category_axioms category_axioms assms(1,2,4) g show
"(?Y_a'b' ∘⇩A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]⇩∘)⦇ArrVal⦈⦇h⦈ =
(cf_hom ℭ [?𝔉g, ?𝔊'f]⇩∘ ∘⇩A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈⦇h⦈"
by
(
cs_concl
cs_simp: nat cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_a'b_Gg𝔉'f arr_Set_𝔉g𝔊'f_ab in auto)
qed (use a'b_Gg𝔉'f 𝔉g𝔊'f_ab in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
subsubsection‹
Composition of the components of a composition of a ‹Hom›-natural
transformation with natural transformations
›
lemma (in category) cat_ntcf_Hom_component_Comp:
assumes "φ' : 𝔊 ↦⇩C⇩F ℌ : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ' : 𝔊' ↦⇩C⇩F ℌ' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows
"ntcf_Hom_component φ ψ' a b ∘⇩A⇘cat_Set α⇙ ntcf_Hom_component φ' ψ a b =
ntcf_Hom_component (φ' ∙⇩N⇩T⇩C⇩F φ) (ψ' ∙⇩N⇩T⇩C⇩F ψ) a b"
(is ‹?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ = ?φ'φψ'ψ›)
proof-
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
from assms Set.category_axioms category_axioms have φψ'_φ'ψ:
"?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ :
Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (ℌ'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
then have dom_lhs:
"𝒟⇩∘ ((?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈) =
Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from assms Set.category_axioms category_axioms have φ'φψ'ψ:
"?φ'φψ'ψ :
Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (ℌ'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
then have dom_rhs:
"𝒟⇩∘ (?φ'φψ'ψ⦇ArrVal⦈) = Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from φψ'_φ'ψ show arr_Set_φψ'_φ'ψ: "arr_Set α (?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ)"
by (auto dest: cat_Set_is_arrD(1))
from φ'φψ'ψ show arr_Set_φ'φψ'ψ: "arr_Set α ?φ'φψ'ψ"
by (auto dest: cat_Set_is_arrD(1))
show "(?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈ = ?φ'φψ'ψ⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : ℌ⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
with category_axioms assms Set.category_axioms show
"(?φψ' ∘⇩A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈⦇f⦈ = ?φ'φψ'ψ⦇ArrVal⦈⦇f⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_φ'φψ'ψ arr_Set_φψ'_φ'ψ in auto)
qed (use φψ'_φ'ψ φ'φψ'ψ in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp
subsubsection‹
Component of a composition of ‹Hom›-natural
transformation with the identity natural transformations
›
lemma (in category) cat_ntcf_Hom_component_ntcf_id:
assumes "𝔉 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "𝔉': 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows
"ntcf_Hom_component (ntcf_id 𝔉) (ntcf_id 𝔉') a b =
cat_Set α⦇CId⦈⦇Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦈"
(is ‹?𝔉𝔉' = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈›)
proof-
interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
interpret 𝔉': is_functor α 𝔅 ℭ 𝔉' by (rule assms(2))
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
from assms Set.category_axioms category_axioms have 𝔉𝔉':
"?𝔉𝔉' :
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
then have dom_lhs: "𝒟⇩∘ (?𝔉𝔉'⦇ArrVal⦈) = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_simp: cat_cs_simps)
from category_axioms assms Set.category_axioms have 𝔉a𝔉'b:
"cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈ :
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ (cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈) = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from 𝔉𝔉' show arr_Set_𝔉ψ: "arr_Set α ?𝔉𝔉'"
by (auto dest: cat_Set_is_arrD(1))
from 𝔉a𝔉'b show arr_Set_𝔉a𝔉'b: "arr_Set α (cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈)"
by (auto dest: cat_Set_is_arrD(1))
show "?𝔉𝔉'⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
with category_axioms Set.category_axioms assms show
"?𝔉𝔉'⦇ArrVal⦈⦇f⦈ = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈⦇f⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros
)
qed (use arr_Set_𝔉a𝔉'b in auto)
qed (use 𝔉𝔉' 𝔉a𝔉'b in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id
subsection‹
Component of a composition of a ‹Hom›-natural transformation
with a natural transformation
›
subsubsection‹Definition and elementary properties›
definition ntcf_lcomp_Hom_component :: "V ⇒ V ⇒ V ⇒ V"
where "ntcf_lcomp_Hom_component φ a b =
ntcf_Hom_component φ (ntcf_id (cf_id (φ⦇NTDGCod⦈))) a b"
definition ntcf_rcomp_Hom_component :: "V ⇒ V ⇒ V ⇒ V"
where "ntcf_rcomp_Hom_component ψ a b =
ntcf_Hom_component (ntcf_id (cf_id (ψ⦇NTDGCod⦈))) ψ a b"
subsubsection‹Arrow value›
lemma ntcf_lcomp_Hom_component_ArrVal_vsv:
"vsv (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈)"
unfolding ntcf_lcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
lemma ntcf_rcomp_Hom_component_ArrVal_vsv:
"vsv (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈)"
unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "𝒟⇩∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
show ?thesis
using assms
unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
shows "𝒟⇩∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrVal_app[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
and "h : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b"
shows "ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈⦇h⦈ = h ∘⇩A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_app[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
and "h : a ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇b⦈"
shows "ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈⦇h⦈ = ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ h"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrVal_vrange:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "ℛ⇩∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) ⊆⇩∘ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms(2) have a: "a ∈⇩∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
from assms(1,3) a have
"ℛ⇩∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) ⊆⇩∘
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈)"
by
(
unfold cat_op_simps ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod,
intro ntcf_Hom_component_ArrVal_vrange
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
from this assms(3) show ?thesis by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_vrange:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "ℛ⇩∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) ⊆⇩∘ Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms(2) have a: "a ∈⇩∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
from assms(1,3) a have
"ℛ⇩∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) ⊆⇩∘
Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔊⦇ObjMap⦈⦇b⦈)"
by
(
unfold ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod,
intro ntcf_Hom_component_ArrVal_vrange
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from this a show ?thesis by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed
subsubsection‹Arrow domain and codomain›
lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_lcomp_Hom_component φ a b⦇ArrDom⦈ = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrDom[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
shows "ntcf_rcomp_Hom_component ψ a b⦇ArrDom⦈ = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms show ?thesis
unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrCod[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_lcomp_Hom_component φ a b⦇ArrCod⦈ = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrCod[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
shows "ntcf_rcomp_Hom_component ψ a b⦇ArrCod⦈ = Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms show ?thesis
unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
subsubsection‹
Component of a composition of a ‹Hom›-natural transformation
with a natural transformation is an arrow in the category ‹Set›
›
lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_lcomp_Hom_component φ a b :
Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms have a: "a ∈⇩∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
from assms(1,3) a have
"ntcf_lcomp_Hom_component φ a b :
Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈)"
unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (intro cat_ntcf_Hom_component_is_arr)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)+
from this assms(1,3) a show ?thesis
by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed
lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr':
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
and "𝔄' = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
and "𝔅' = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
and "ℭ' = cat_Set α"
shows "ntcf_lcomp_Hom_component φ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_ntcf_lcomp_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_component_is_arr'
lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "ntcf_rcomp_Hom_component ψ a b :
Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms have a: "a ∈⇩∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
from assms(1,3) a have
"ntcf_rcomp_Hom_component ψ a b :
Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔉⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔊⦇ObjMap⦈⦇b⦈)"
unfolding ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (intro cat_ntcf_Hom_component_is_arr)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)
from this assms(1,3) a show ?thesis
by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed
lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr':
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
and "𝔄' = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
and "𝔅' = Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
and "ℭ' = cat_Set α"
shows "ntcf_rcomp_Hom_component ψ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_ntcf_rcomp_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_component_is_arr'
subsection‹
Composition of a ‹Hom›-natural transformation with two natural transformations
›
subsubsection‹Definition and elementary properties›
text‹See subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.›
definition ntcf_Hom :: "V ⇒ V ⇒ V ⇒ V" (‹Hom⇩A⇩.⇩Cı'(/_-,_-/')›)
where "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-) =
[
(
λab∈⇩∘(op_cat (φ⦇NTDGDom⦈) ×⇩C ψ⦇NTDGDom⦈)⦇Obj⦈.
ntcf_Hom_component φ ψ (vpfst ab) (vpsnd ab)
),
Hom⇩O⇩.⇩C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTCod⦈-,ψ⦇NTDom⦈-),
Hom⇩O⇩.⇩C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTDom⦈-,ψ⦇NTCod⦈-),
op_cat (φ⦇NTDGDom⦈) ×⇩C ψ⦇NTDGDom⦈,
cat_Set α
]⇩∘"
text‹Components.›
lemma ntcf_Hom_components:
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈ =
(
λab∈⇩∘(op_cat (φ⦇NTDGDom⦈) ×⇩C ψ⦇NTDGDom⦈)⦇Obj⦈.
ntcf_Hom_component φ ψ (vpfst ab) (vpsnd ab)
)"
and "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTDom⦈ =
Hom⇩O⇩.⇩C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTCod⦈-,ψ⦇NTDom⦈-)"
and "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTCod⦈ =
Hom⇩O⇩.⇩C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTDom⦈-,ψ⦇NTCod⦈-)"
and "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTDGDom⦈ = op_cat (φ⦇NTDGDom⦈) ×⇩C ψ⦇NTDGDom⦈"
and "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTDGCod⦈ = cat_Set α"
unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_Hom_components(1)
|vsv ntcf_Hom_NTMap_vsv|
context
fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
assumes φ: "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and ψ: "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)
mk_VLambda ntcf_Hom_components(1)[of _ φ ψ, simplified]
|vdomain ntcf_Hom_NTMap_vdomain[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] = ntcf_Hom_NTMap_vdomain
lemma ntcf_Hom_NTMap_app[cat_cs_simps]:
assumes "[a, b]⇩∘ ∈⇩∘ (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇a, b⦈⇩∙ = ntcf_Hom_component φ ψ a b"
using assms
unfolding ntcf_Hom_components
by (simp add: nat_omega_simps cat_cs_simps)
end
lemma (in category) ntcf_Hom_NTMap_vrange:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "ℛ⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈) ⊆⇩∘ cat_Set α⦇Arr⦈"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
show ?thesis
proof
(
rule vsv.vsv_vrange_vsubset,
unfold ntcf_Hom_NTMap_vdomain[OF assms] cat_cs_simps
)
fix ab assume "ab ∈⇩∘ (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
then obtain a b
where ab_def: "ab = [a, b]⇩∘"
and a: "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
by
(
rule cat_prod_2_ObjE[
OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
]
)
from assms a b category_cat_Set category_axioms show
"Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ ∈⇩∘ cat_Set α⦇Arr⦈"
unfolding ab_def cat_op_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (simp add: ntcf_Hom_NTMap_vsv)
qed
subsubsection‹
Composition of a ‹Hom›-natural transformation with
two natural transformations is a natural transformation
›
lemma (in category) cat_ntcf_Hom_is_ntcf:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-) :
op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-))" unfolding ntcf_Hom_def by simp
show "vcard (Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)) = 5⇩ℕ"
unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
from assms category_axioms show
"Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-) : op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_intro: cat_cs_intros)
from assms category_axioms show
"Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-) : op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_intro: cat_cs_intros)
from assms show "𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈) = (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ObjMap⦈⦇ab⦈ ↦⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ObjMap⦈⦇ab⦈"
if "ab ∈⇩∘ (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈" for ab
proof-
from that obtain a b
where ab_def: "ab = [a, b]⇩∘"
and a: "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
by
(
rule cat_prod_2_ObjE[
OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
]
)
from category_axioms assms a b show
"Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ObjMap⦈⦇ab⦈ ↦⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ObjMap⦈⦇ab⦈"
unfolding ab_def cat_op_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇a'b'⦈ ∘⇩A⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ArrMap⦈⦇gf⦈ =
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ArrMap⦈⦇gf⦈ ∘⇩A⇘cat_Set α⇙
Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈"
if "gf : ab ↦⇘op_cat 𝔄 ×⇩C 𝔅⇙ a'b'" for ab a'b' gf
proof-
from that obtain g f a b a' b'
where gf_def: "gf = [g, f]⇩∘"
and ab_def: "ab = [a, b]⇩∘"
and a'b'_def: "a'b' = [a', b']⇩∘"
and g: "g : a ↦⇘op_cat 𝔄⇙ a'"
and f: "f : b ↦⇘𝔅⇙ b'"
by
(
elim
cat_prod_2_is_arrE[
OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
]
)
from assms category_axioms that g f show ?thesis
unfolding gf_def ab_def a'b'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_ntcf_Hom_component_nat cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: ntcf_Hom_components cat_cs_simps)
qed
lemma (in category) cat_ntcf_Hom_is_ntcf':
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "β = α"
and "𝔄' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,𝔉'-)"
and "𝔅' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔊'-)"
and "ℭ' = op_cat 𝔄 ×⇩C 𝔅"
and "𝔇' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ-) : 𝔄' ↦⇩C⇩F 𝔅' : ℭ' ↦↦⇩C⇘β⇙ 𝔇'"
using assms(1-2) unfolding assms(3-7) by (rule cat_ntcf_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_is_ntcf'
subsubsection‹
Composition of a ‹Hom›-natural transformation with
two vertical compositions of natural transformations
›
lemma (in category) cat_ntcf_Hom_vcomp:
assumes "φ' : 𝔊 ↦⇩C⇩F ℌ : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "ψ' : 𝔊' ↦⇩C⇩F ℌ' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "ψ : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows
"Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,ψ' ∙⇩N⇩T⇩C⇩F ψ-) =
Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,ψ-)"
proof(rule ntcf_eqI[of α])
interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
interpret ψ': is_ntcf α 𝔅 ℭ 𝔊' ℌ' ψ' by (rule assms(3))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(4))
from category_axioms assms show H_vcomp:
"Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,ψ' ∙⇩N⇩T⇩C⇩F ψ-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(ℌ-,𝔉'-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,ℌ'-) :
op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show vcomp_H:
"Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,ψ-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(ℌ-,𝔉'-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,ℌ'-) :
op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_vcomp have dom_H_vcomp:
"𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,ψ' ∙⇩N⇩T⇩C⇩F ψ-)⦇NTMap⦈) = (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_vcomp have dom_vcomp_H:
"𝒟⇩∘ ((Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,ψ-))⦇NTMap⦈) =
(op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,ψ' ∙⇩N⇩T⇩C⇩F ψ-)⦇NTMap⦈ =
(Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,ψ-))⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
fix ab assume prems: "ab ∈⇩∘ (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
then obtain a b
where ab_def: "ab = [a, b]⇩∘"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
by
(
auto
elim:
cat_prod_2_ObjE[
OF φ'.NTDom.HomDom.category_op ψ'.NTDom.HomDom.category_axioms
]
simp: cat_op_simps
)
from
assms a b
category_axioms
φ'.NTDom.HomDom.category_axioms
ψ'.NTDom.HomDom.category_axioms
show
"Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,ψ' ∙⇩N⇩T⇩C⇩F ψ-)⦇NTMap⦈⦇ab⦈ =
(Hom⇩A⇩.⇩C⇘α⇙(φ-,ψ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,ψ-))⦇NTMap⦈⦇ab⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps ab_def
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto simp: ntcf_Hom_NTMap_vsv cat_cs_intros)
qed simp_all
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_vcomp
lemma (in category) cat_ntcf_Hom_ntcf_id:
assumes "𝔉 : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "𝔉': 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-)"
proof(rule ntcf_eqI[of α])
interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
interpret 𝔉': is_functor α 𝔅 ℭ 𝔉' by (rule assms(2))
from category_axioms assms show H_id:
"Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-) :
op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show id_H:
"ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-) :
op_cat 𝔄 ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_id have dom_H_id:
"𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_id have dom_id_H:
"𝒟⇩∘ (ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈ =
ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
show "vsv (Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈)"
by (rule ntcf_Hom_NTMap_vsv)
from id_H show "vsv (ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈)"
by (intro is_functor.ntcf_id_NTMap_vsv)
(cs_concl cs_shallow cs_intro: cat_cs_intros)
fix ab assume "ab ∈⇩∘ (op_cat 𝔄 ×⇩C 𝔅)⦇Obj⦈"
then obtain a b
where ab_def: "ab = [a, b]⇩∘"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
by
(
auto
elim:
cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉'.HomDom.category_axioms]
simp: cat_op_simps
)
from category_axioms assms a b H_id id_H show
"Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈⦇ab⦈ =
ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈⦇ab⦈"
unfolding ab_def
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed simp
qed simp_all
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_ntcf_id
subsection‹
Composition of a ‹Hom›-natural transformation with a natural transformation
›
subsubsection‹Definition and elementary properties›
text‹See subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.›
definition ntcf_lcomp_Hom :: "V ⇒ V ⇒ V" (‹Hom⇩A⇩.⇩Cı'(/_-,-/')›)
where "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) = Hom⇩A⇩.⇩C⇘α⇙(φ-,ntcf_id (cf_id (φ⦇NTDGCod⦈))-)"
definition ntcf_rcomp_Hom :: "V ⇒ V ⇒ V" (‹Hom⇩A⇩.⇩Cı'(/-,_-/')›)
where "Hom⇩A⇩.⇩C⇘α⇙(-,ψ-) = Hom⇩A⇩.⇩C⇘α⇙(ntcf_id (cf_id (ψ⦇NTDGCod⦈))-,ψ-)"
subsubsection‹Natural transformation map›
lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⦇NTMap⦈)"
unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (Hom⇩A⇩.⇩C⇘α⇙(-,ψ-)⦇NTMap⦈)"
unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⦇NTMap⦈) = (op_cat 𝔄 ×⇩C ℭ)⦇Obj⦈"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_def φ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_NTMap_vdomain[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(-,ψ-)⦇NTMap⦈) = (op_cat ℭ ×⇩C 𝔅)⦇Obj⦈"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_rcomp_Hom_def ψ.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_NTMap_app[cat_cs_simps]:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⦇NTMap⦈⦇a, b⦈⇩∙ = ntcf_lcomp_Hom_component φ a b"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms show ?thesis
unfolding
ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma ntcf_rcomp_Hom_NTMap_app[cat_cs_simps]:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "a ∈⇩∘ op_cat ℭ⦇Obj⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙(-,ψ-)⦇NTMap⦈⦇a, b⦈⇩∙ = ntcf_rcomp_Hom_component ψ a b"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms show ?thesis
unfolding
ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma (in category) ntcf_lcomp_Hom_NTMap_vrange:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "ℛ⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⦇NTMap⦈) ⊆⇩∘ cat_Set α⦇Arr⦈"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) ntcf_rcomp_Hom_NTMap_vrange:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "ℛ⇩∘ (Hom⇩A⇩.⇩C⇘α⇙(-,ψ-)⦇NTMap⦈) ⊆⇩∘ cat_Set α⦇Arr⦈"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms show ?thesis
unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed
subsubsection‹
Composition of a ‹Hom›-natural transformation with
a natural transformation is a natural transformation
›
lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) : op_cat 𝔄 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms category_axioms show ?thesis
unfolding
ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] φ.ntcf_NTDGCod
by (intro category.cat_ntcf_Hom_is_ntcf)
(cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf':
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
and "β = α"
and "𝔄' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)"
and "𝔅' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)"
and "ℭ' = op_cat 𝔄 ×⇩C ℭ"
and "𝔇' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) : 𝔄' ↦⇩C⇩F 𝔅' : ℭ' ↦↦⇩C⇘β⇙ 𝔇'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_lcomp_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_is_ntcf'
lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf:
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(-,ψ-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔉-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) : op_cat ℭ ×⇩C 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
from assms category_axioms show ?thesis
unfolding
ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] ψ.ntcf_NTDGCod
by (intro category.cat_ntcf_Hom_is_ntcf)
(cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf':
assumes "ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "β = α"
and "𝔄' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔉-)"
and "𝔅' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)"
and "ℭ' = op_cat ℭ ×⇩C 𝔅"
and "𝔇' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙(-,ψ-) : 𝔄' ↦⇩C⇩F 𝔅' : ℭ' ↦↦⇩C⇘α⇙ 𝔇'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_rcomp_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_is_ntcf'
subsubsection‹
Component of a composition of a ‹Hom›-natural transformation
with a natural transformation and the Yoneda component
›
lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "b ∈⇩∘ op_cat 𝔅⦇Obj⦈"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows
"ntcf_lcomp_Hom_component φ b c =
Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈) (φ⦇NTMap⦈⦇b⦈) c"
(is ‹?lcomp = ?Yc›)
proof-
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms(2) have b: "b ∈⇩∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by clarsimp
from b have 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈" and 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
by (auto intro: cat_cs_intros)
from assms(1,3) b category_axioms have φb:
"φ⦇NTMap⦈⦇b⦈ ∈⇩∘ Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-)⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
have lcomp:
"?lcomp : Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇b⦈) c"
by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
then have dom_lhs: "𝒟⇩∘ (?lcomp⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c"
by (cs_concl cs_simp: cat_cs_simps)
have Yc: "?Yc :
Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-)⦇ObjMap⦈⦇c⦈"
by
(
rule cat_Yoneda_component_is_arr[
OF cat_cf_Hom_snd_is_functor[OF 𝔉b] 𝔊b φb assms(3)
]
)
then have dom_rhs: "𝒟⇩∘ (?Yc⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from lcomp show "arr_Set α ?lcomp" by (auto dest: cat_Set_is_arrD(1))
from Yc show "arr_Set α ?Yc" by (auto dest: cat_Set_is_arrD(1))
show "?lcomp⦇ArrVal⦈ = ?Yc⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
from assms(1) b category_axioms show "vsv (?Yc⦇ArrVal⦈)"
by (intro is_functor.Yoneda_component_ArrVal_vsv)
(cs_concl cs_shallow cs_intro: cat_cs_intros)
show "?lcomp⦇ArrVal⦈⦇f⦈ = ?Yc⦇ArrVal⦈⦇f⦈"
if "f ∈⇩∘ Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c" for f
proof-
from that have "f : 𝔊⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ c" by simp
with category_axioms assms(1,3) b show ?thesis
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed (simp_all add: ntcf_lcomp_Hom_component_ArrVal_vsv)
from Yc category_axioms assms(1,3) b have
"?Yc : Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇b⦈) c"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
with lcomp show "?lcomp⦇ArrCod⦈ = ?Yc⦇ArrCod⦈"
by (cs_concl cs_simp: cat_cs_simps)
qed (use lcomp Yc in ‹cs_concl cs_simp: cat_cs_simps›)
qed
subsubsection‹
Composition of a ‹Hom›-natural transformation with
a vertical composition of natural transformations
›
lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
assumes "φ' : 𝔊 ↦⇩C⇩F ℌ : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ' ∙⇩N⇩T⇩C⇩F φ-,-) = Hom⇩A⇩.⇩C⇘α⇙(φ-,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(φ'-,-)"
proof-
interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
from category_axioms have ntcf_id_cf_id:
"ntcf_id (cf_id ℭ) = ntcf_id (cf_id ℭ) ∙⇩N⇩T⇩C⇩F ntcf_id (cf_id ℭ)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show ?thesis
unfolding
ntcf_lcomp_Hom_def
ntsmcf_vcomp_components
dghm_id_components
φ'.ntcf_NTDGCod
φ.ntcf_NTDGCod
by (subst ntcf_id_cf_id)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_vcomp
lemma (in category) cat_ntcf_rcomp_Hom_vcomp:
assumes "φ' : 𝔊 ↦⇩C⇩F ℌ : 𝔄 ↦↦⇩C⇘α⇙ ℭ" and "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(-,φ' ∙⇩N⇩T⇩C⇩F φ-) = Hom⇩A⇩.⇩C⇘α⇙(-,φ'-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙(-,φ-)"
proof-
interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
from category_axioms have ntcf_id_cf_id:
"ntcf_id (cf_id ℭ) = ntcf_id (cf_id ℭ) ∙⇩N⇩T⇩C⇩F ntcf_id (cf_id ℭ)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show ?thesis
unfolding
ntcf_rcomp_Hom_def
ntsmcf_vcomp_components
dghm_id_components
φ'.ntcf_NTDGCod
φ.ntcf_NTDGCod
by (subst ntcf_id_cf_id)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_vcomp
subsubsection‹
Composition of a ‹Hom›-natural transformation with an identity natural
transformation
›
lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
assumes "𝔉 : 𝔄 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(ntcf_id 𝔉-,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)"
proof-
interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
from category_axioms assms show ?thesis
unfolding ntcf_lcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
by
(
cs_concl
cs_simp: ntcf_lcomp_Hom_def cat_cs_simps
cs_intro: cat_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_id
lemma (in category) cat_ntcf_rcomp_Hom_ntcf_id:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(-,ntcf_id 𝔉-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔉-)"
proof-
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
from category_axioms assms show ?thesis
unfolding ntcf_rcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
by (cs_concl cs_simp: ntcf_rcomp_Hom_def cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_ntcf_id
subsection‹Projections of a ‹Hom›-natural transformation›
text‹
The concept of a projection of a ‹Hom›-natural transformation appears
in the corollary to the Yoneda Lemma in Chapter III-2 in
\<^cite>‹"mac_lane_categories_2010"› (although the concept has not been given
any specific name in the aforementioned reference).
›
subsubsection‹Definition and elementary properties›
definition ntcf_Hom_snd :: "V ⇒ V ⇒ V ⇒ V" (‹Hom⇩A⇩.⇩Cı_'(/_,-/')›)
where "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) =
Yoneda_arrow α (Hom⇩O⇩.⇩C⇘α⇙ℭ(ℭ⦇Dom⦈⦇f⦈,-)) (ℭ⦇Cod⦈⦇f⦈) f"
definition ntcf_Hom_fst :: "V ⇒ V ⇒ V ⇒ V" (‹Hom⇩A⇩.⇩Cı_'(/-,_/')›)
where "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) = Hom⇩A⇩.⇩C⇘α⇙op_cat ℭ(f,-)"
text‹Components.›
lemma (in category) cat_ntcf_Hom_snd_components:
assumes "f : s ↦⇘ℭ⇙ r"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTMap⦈ =
(λd∈⇩∘ℭ⦇Obj⦈. Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r f d)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDGDom⦈ = ℭ"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDGCod⦈ = cat_Set α"
proof-
interpret is_functor α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)›
using assms category_axioms by (cs_concl cs_intro: cat_cs_intros)
show "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTMap⦈ =
(λd∈⇩∘ℭ⦇Obj⦈. Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r f d)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDGDom⦈ = ℭ"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦇NTDGCod⦈ = cat_Set α"
unfolding ntcf_Hom_snd_def cat_is_arrD[OF assms] Yoneda_arrow_components
by simp_all
qed
lemma (in category) cat_ntcf_Hom_fst_components:
assumes "f : r ↦⇘ℭ⇙ s"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦇NTMap⦈ =
(λd∈⇩∘op_cat ℭ⦇Obj⦈. Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r f d)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s)"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦇NTDGDom⦈ = op_cat ℭ"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦇NTDGCod⦈ = cat_Set α"
using category_axioms assms
unfolding
ntcf_Hom_fst_def
category.cat_ntcf_Hom_snd_components[
OF category_op, unfolded cat_op_simps, OF assms
]
cat_op_simps
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+
text‹Alternative definition.›
lemma (in category) ntcf_Hom_snd_def':
assumes "f : r ↦⇘ℭ⇙ s"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) = Yoneda_arrow α (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)) s f"
using assms unfolding ntcf_Hom_snd_def by (simp add: cat_cs_simps)
lemma (in category) ntcf_Hom_fst_def':
assumes "f : r ↦⇘ℭ⇙ s"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) = Yoneda_arrow α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r f"
proof-
from assms category_axioms show ?thesis
unfolding ntcf_Hom_fst_def ntcf_Hom_snd_def cat_op_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
qed
subsubsection‹Natural transformation map›
context category
begin
context
fixes s r f
assumes f: "f : s ↦⇘ℭ⇙ r"
begin
mk_VLambda cat_ntcf_Hom_snd_components(1)[OF f]
|vsv ntcf_Hom_snd_NTMap_vsv[intro]|
|vdomain ntcf_Hom_snd_NTMap_vdomain|
|app ntcf_Hom_snd_NTMap_app|
end
context
fixes s r f
assumes f: "f : r ↦⇘ℭ⇙ s"
begin
mk_VLambda cat_ntcf_Hom_fst_components(1)[OF f]
|vsv ntcf_Hom_fst_NTMap_vsv[intro]|
|vdomain ntcf_Hom_fst_NTMap_vdomain|
|app ntcf_Hom_fst_NTMap_app|
end
end
lemmas [cat_cs_simps] =
category.ntcf_Hom_snd_NTMap_vdomain
category.ntcf_Hom_fst_NTMap_vdomain
lemmas ntcf_Hom_snd_NTMap_app[cat_cs_simps] =
category.ntcf_Hom_snd_NTMap_app
category.ntcf_Hom_fst_NTMap_app
subsubsection‹
‹Hom›-natural transformation projections are natural transformations
›
lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
assumes "f : s ↦⇘ℭ⇙ r"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
note f = cat_is_arrD[OF assms]
show ?thesis
unfolding ntcf_Hom_snd_def f
proof(rule category.cat_Yoneda_arrow_is_ntcf)
from assms category_axioms show "f ∈⇩∘ Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)⦇ObjMap⦈⦇r⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed (intro category_axioms cat_cf_Hom_snd_is_functor f)+
qed
lemma (in category) cat_ntcf_Hom_snd_is_ntcf':
assumes "f : s ↦⇘ℭ⇙ r"
and "β = α"
and "𝔄' = Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
and "𝔅' = Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
and "ℭ' = ℭ"
and "𝔇' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) : 𝔄' ↦⇩C⇩F 𝔅' : ℭ' ↦↦⇩C⇘β⇙ 𝔇'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_snd_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_snd_is_ntcf'
lemma (in category) cat_ntcf_Hom_fst_is_ntcf:
assumes "f : r ↦⇘ℭ⇙ s"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
from assms have r: "r ∈⇩∘ ℭ⦇Obj⦈" and s: "s ∈⇩∘ ℭ⦇Obj⦈" by auto
from
category.cat_ntcf_Hom_snd_is_ntcf[
OF category_op,
unfolded cat_op_simps,
OF assms,
unfolded cat_op_cat_cf_Hom_snd[OF r] cat_op_cat_cf_Hom_snd[OF s],
folded ntcf_Hom_fst_def
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_fst_is_ntcf':
assumes "f : r ↦⇘ℭ⇙ s"
and "β = α"
and "𝔄' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r)"
and "𝔅' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s)"
and "ℭ' = op_cat ℭ"
and "𝔇' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) : 𝔄' ↦⇩C⇩F 𝔅' : ℭ' ↦↦⇩C⇘β⇙ 𝔇'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_fst_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_fst_is_ntcf'
subsubsection‹Opposite ‹Hom›-natural transformation projections›
lemma (in category) cat_op_cat_ntcf_Hom_snd:
"Hom⇩A⇩.⇩C⇘α⇙op_cat ℭ(f,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)"
unfolding ntcf_Hom_fst_def by simp
lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_snd
lemma (in category) cat_op_cat_ntcf_Hom_fst:
"Hom⇩A⇩.⇩C⇘α⇙op_cat ℭ(-,f) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
unfolding ntcf_Hom_fst_def cat_op_simps by simp
lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst
subsubsection‹
‹Hom›-natural transformation projections and the Yoneda component
›
lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b" and "d ∈⇩∘ ℭ⦇Obj⦈"
shows
"Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b f d ∘⇩A⇘cat_Set α⇙
Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) c g d =
Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) c (g ∘⇩A⇘ℭ⇙ f) d"
(is ‹?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d = ?Ya c (g ∘⇩A⇘ℭ⇙ f) d›)
proof-
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
note gD = cat_is_arrD[OF assms(1)]
note fD = cat_is_arrD[OF assms(2)]
from assms category_axioms have Y_f:
"?Ya b f d : Hom ℭ b d ↦⇘cat_Set α⇙ Hom ℭ a d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
moreover from assms category_axioms have Y_g:
"?Yb c g d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ b d"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
ultimately have Yf_Yg:
"?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ a d"
by (auto intro: cat_cs_intros)
from assms category_axioms have Y_gf:
"?Ya c (g ∘⇩A⇘ℭ⇙ f) d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ a d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from Yf_Yg have dom_rhs:
"𝒟⇩∘ ((?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈) = Hom ℭ c d"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from Y_gf have dom_lhs: "𝒟⇩∘ (?Ya c (g ∘⇩A⇘ℭ⇙ f) d⦇ArrVal⦈) = Hom ℭ c d"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from Yf_Yg show arr_Set_Yf_Yg:
"arr_Set α (?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d)"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set α ‹?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d›
by (rule arr_Set_Yf_Yg)
from Y_gf show arr_Set_Y_gf: "arr_Set α (?Ya c (g ∘⇩A⇘ℭ⇙ f) d)"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set α ‹?Ya c (g ∘⇩A⇘ℭ⇙ f) d› by (rule arr_Set_Y_gf)
show
"(?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈ =
?Ya c (g ∘⇩A⇘ℭ⇙ f) d⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume "h : c ↦⇘ℭ⇙ d"
with Y_gf Y_g Y_f category_axioms assms show
"(?Ya b f d ∘⇩A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈⦇h⦈ =
?Ya c (g ∘⇩A⇘ℭ⇙ f) d⦇ArrVal⦈⦇h⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed auto
qed (use Y_gf Yf_Yg in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] =
category.cat_Yoneda_component_cf_Hom_snd_Comp[symmetric]
lemma (in category) cat_Yoneda_component_cf_Hom_snd_CId:
assumes "c ∈⇩∘ ℭ⦇Obj⦈" and "d ∈⇩∘ ℭ⦇Obj⦈"
shows
"Yoneda_component Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) c (ℭ⦇CId⦈⦇c⦈) d =
cat_Set α⦇CId⦈⦇Hom ℭ c d⦈"
(is ‹?Ycd = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈›)
proof-
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
from assms category_axioms have Y_CId_c:
"?Ycd : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ c d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from Y_CId_c Set.category_axioms assms category_axioms have CId_cd:
"cat_Set α⦇CId⦈⦇Hom ℭ c d⦈ : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ c d"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from Y_CId_c have dom_lhs: "𝒟⇩∘ (?Ycd⦇ArrVal⦈) = Hom ℭ c d"
by (cs_concl cs_simp: cat_cs_simps)
from CId_cd have dom_rhs: "𝒟⇩∘ (cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈) = Hom ℭ c d"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from Y_CId_c show arr_Set_Y_CId_c: "arr_Set α ?Ycd"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set α ?Ycd by (rule arr_Set_Y_CId_c)
from CId_cd show arr_Set_CId_cd: "arr_Set α (cat_Set α⦇CId⦈⦇Hom ℭ c d⦈)"
by (auto dest: cat_Set_is_arrD(1))
interpret CId_cd: arr_Set α ‹cat_Set α⦇CId⦈⦇Hom ℭ c d⦈›
by (rule arr_Set_CId_cd)
show "?Ycd⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume "h : c ↦⇘ℭ⇙ d"
with CId_cd Y_CId_c category_axioms assms show
"?Ycd⦇ArrVal⦈⦇h⦈ = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈⦇h⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed auto
qed (use Y_CId_c CId_cd in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId
subsubsection‹‹Hom›-natural transformation projection of a composition›
lemma (in category) cat_ntcf_Hom_snd_Comp:
assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(g ∘⇩A⇘ℭ⇙ f,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-)"
(is ‹?H_gf = ?H_f ∙⇩N⇩T⇩C⇩F ?H_g›)
proof(rule ntcf_eqI[of α])
from assms category_axioms show
"?H_gf : Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show "?H_f ∙⇩N⇩T⇩C⇩F ?H_g :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have lhs_dom: "𝒟⇩∘ (?H_gf⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have rhs_dom:
"𝒟⇩∘ ((?H_f ∙⇩N⇩T⇩C⇩F ?H_g)⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?H_gf⦇NTMap⦈ = (?H_f ∙⇩N⇩T⇩C⇩F ?H_g)⦇NTMap⦈"
proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
fix d assume "d ∈⇩∘ ℭ⦇Obj⦈"
with assms category_axioms show
"?H_gf⦇NTMap⦈⦇d⦈ = (?H_f ∙⇩N⇩T⇩C⇩F ?H_g)⦇NTMap⦈⦇d⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use assms in ‹auto intro: cat_cs_intros›)
qed auto
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp
lemma (in category) cat_ntcf_Hom_fst_Comp:
assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,g ∘⇩A⇘ℭ⇙ f) = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,g) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)"
proof-
note category.cat_ntcf_Hom_snd_Comp[
OF category_op, unfolded cat_op_simps, OF assms(2,1)
]
from this category_axioms assms show ?thesis
by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_Comp
subsubsection‹‹Hom›-natural transformation projection of an identity›
lemma (in category) cat_ntcf_Hom_snd_CId:
assumes "c ∈⇩∘ ℭ⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(ℭ⦇CId⦈⦇c⦈,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-)"
(is ‹?H_c = ?id_H_c›)
proof(rule ntcf_eqI[of α])
from assms have "ℭ⦇CId⦈⦇c⦈ : c ↦⇘ℭ⇙ c" by (auto simp: cat_cs_intros)
from assms category_axioms show
"?H_c : Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show
"?id_H_c : Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have lhs_dom: "𝒟⇩∘ (?H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have rhs_dom: "𝒟⇩∘ (?id_H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?H_c⦇NTMap⦈ = ?id_H_c⦇NTMap⦈"
proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
from assms category_axioms show "vsv (?id_H_c⦇NTMap⦈)"
by (intro is_functor.ntcf_id_NTMap_vsv)
(cs_concl cs_shallow cs_simp: cs_intro: cat_cs_intros)
fix d assume "d ∈⇩∘ ℭ⦇Obj⦈"
with assms category_axioms show "?H_c⦇NTMap⦈⦇d⦈ = ?id_H_c⦇NTMap⦈⦇d⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
qed (use assms in ‹auto intro: cat_cs_intros›)
qed auto
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId
lemma (in category) cat_ntcf_Hom_fst_CId:
assumes "c ∈⇩∘ ℭ⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,ℭ⦇CId⦈⦇c⦈) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(-,c)"
proof-
note category.cat_ntcf_Hom_snd_CId[
OF category_op, unfolded cat_op_simps, OF assms
]
from this category_axioms assms show ?thesis
by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_CId
subsubsection‹‹Hom›-natural transformation and the Yoneda map›
lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
assumes "f : s ↦⇘ℭ⇙ r"
shows "Yoneda_map α (Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)) r⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦈ = f"
using category_axioms assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_Set_components(1)
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_snd
lemma (in category) cat_Yoneda_map_of_ntcf_Hom_fst:
assumes "f : r ↦⇘ℭ⇙ s"
shows "Yoneda_map α (Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s)) r⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦈ = f"
proof-
note category.cat_Yoneda_map_of_ntcf_Hom_snd[
OF category_op, unfolded cat_op_simps, OF assms
]
from this category_axioms assms show ?thesis
by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_fst
subsection‹Evaluation arrow›
subsubsection‹Definition and elementary properties›
text‹
The evaluation arrow is a part of the definition of the evaluation functor.
The evaluation functor appears in Chapter III-2 in
\<^cite>‹"mac_lane_categories_2010"›.
›
definition cf_eval_arrow :: "V ⇒ V ⇒ V ⇒ V"
where "cf_eval_arrow ℭ 𝔑 f =
[
(
λx∈⇩∘𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈.
𝔑⦇NTCod⦈⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈⦇ArrVal⦈⦇x⦈⦈
),
𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈,
𝔑⦇NTCod⦈⦇ObjMap⦈⦇ℭ⦇Cod⦈⦇f⦈⦈
]⇩∘"
text‹Components.›
lemma cf_eval_arrow_components:
shows "cf_eval_arrow ℭ 𝔑 f⦇ArrVal⦈ =
(
λx∈⇩∘𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈.
𝔑⦇NTCod⦈⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈⦇ArrVal⦈⦇x⦈⦈
)"
and "cf_eval_arrow ℭ 𝔑 f⦇ArrDom⦈ = 𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈"
and "cf_eval_arrow ℭ 𝔑 f⦇ArrCod⦈ = 𝔑⦇NTCod⦈⦇ObjMap⦈⦇ℭ⦇Cod⦈⦇f⦈⦈"
unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔑 ℭ 𝔉 𝔊 a b f
assumes 𝔑: "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and f: "f : a ↦⇘ℭ⇙ b"
begin
interpretation 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule 𝔑)
lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
where ℭ=ℭ and 𝔑=‹ntcf_arrow 𝔑› and f=f,
unfolded
ntcf_arrow_components
cf_map_components
𝔑.NTDom.HomDom.cat_is_arrD[OF f]
cat_cs_simps
]
lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)
end
subsubsection‹Arrow value›
context
fixes α 𝔑 ℭ 𝔉 𝔊 a b f
assumes 𝔑: "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and f: "f : a ↦⇘ℭ⇙ b"
begin
mk_VLambda cf_eval_arrow_components'(1)[OF 𝔑 f]
|vsv cf_eval_arrow_ArrVal_vsv[cat_cs_intros]|
|vdomain cf_eval_arrow_ArrVal_vdomain[cat_cs_simps]|
|app cf_eval_arrow_ArrVal_app[cat_cs_simps]|
end
subsubsection‹Evaluation arrow is an arrow in the category ‹Set››
lemma cf_eval_arrow_is_arr:
assumes "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "f : a ↦⇘ℭ⇙ b"
shows "cf_eval_arrow ℭ (ntcf_arrow 𝔑) f :
𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ 𝔊⦇ObjMap⦈⦇b⦈"
proof-
interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms)
show ?thesis
proof
(
intro cat_Set_is_arrI arr_SetI,
unfold cf_eval_arrow_components'(2,3)[OF assms]
)
show "vfsequence (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f)"
unfolding cf_eval_arrow_def by simp
show "vcard (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f) = 3⇩ℕ"
unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f⦇ArrVal⦈) ⊆⇩∘ 𝔊⦇ObjMap⦈⦇b⦈"
by
(
unfold cf_eval_arrow_components'[OF assms],
intro vrange_VLambda_vsubset
)
(
use assms in
‹cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros›
)+
qed
(
use assms(2) in
‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
)+
qed
lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
assumes "𝔑' = ntcf_arrow 𝔑"
and "𝔉a = 𝔉⦇ObjMap⦈⦇a⦈"
and "𝔊b = 𝔊⦇ObjMap⦈⦇b⦈"
and "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "f : a ↦⇘ℭ⇙ b"
shows "cf_eval_arrow ℭ 𝔑' f : 𝔉a ↦⇘cat_Set α⇙ 𝔊b"
using assms(4,5) unfolding assms(1-3) by (rule cf_eval_arrow_is_arr)
lemma (in category) cat_cf_eval_arrow_ntcf_vcomp[cat_cs_simps]:
assumes "𝔐 : 𝔊 ↦⇩C⇩F ℌ : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "g : b ↦⇘ℭ⇙ c"
and "f : a ↦⇘ℭ⇙ b"
shows
"cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f) =
cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f"
proof-
interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› 𝔊 ℌ 𝔐 by (rule assms(1))
interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(2))
have 𝔐𝔑: "𝔐 ∙⇩N⇩T⇩C⇩F 𝔑 : 𝔉 ↦⇩C⇩F ℌ : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3,4) have gf: "g ∘⇩A⇘ℭ⇙ f : a ↦⇘ℭ⇙ c"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from 𝔐𝔑 gf have cf_eval_gf:
"cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f) :
𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ ℌ⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3,4) have cf_eval_g_cf_eval_f:
"cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f :
𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ ℌ⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note cf_eval_gf = cf_eval_gf cat_Set_is_arrD[OF cf_eval_gf]
note cf_eval_g_cf_eval_f =
cf_eval_g_cf_eval_f cat_Set_is_arrD[OF cf_eval_g_cf_eval_f]
interpret arr_Set_cf_eval_gf:
arr_Set α ‹cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f)›
by (rule cf_eval_gf(2))
interpret arr_Set_cf_eval_g_cf_eval_f:
arr_Set
α
‹
cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
›
by (rule cf_eval_g_cf_eval_f(2))
show ?thesis
proof(rule arr_Set_eqI)
from 𝔐𝔑 gf have dom_lhs:
"𝒟⇩∘ (cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f)⦇ArrVal⦈) =
𝔉⦇ObjMap⦈⦇a⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from cf_eval_g_cf_eval_f(1) have dom_rhs:
"𝒟⇩∘
(
(
cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
)⦇ArrVal⦈
) = 𝔉⦇ObjMap⦈⦇a⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show
"cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f)⦇ArrVal⦈ =
(
cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix 𝔉a assume prems: "𝔉a ∈⇩∘ 𝔉⦇ObjMap⦈⦇a⦈"
from
ArrVal_eq_helper
[
OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric],
where a=‹𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈›
]
prems
assms(3,4)
have [cat_cs_simps]:
"ℌ⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈⦈⦈ =
𝔐⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈⦈⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
)
from prems assms(3,4) show
"cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙⇩N⇩T⇩C⇩F 𝔑)) (g ∘⇩A⇘ℭ⇙ f)⦇ArrVal⦈⦇𝔉a⦈ =
(
cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘⇩A⇘cat_Set α⇙
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
)⦇ArrVal⦈⦇𝔉a⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
)
qed (cs_concl cs_shallow cs_intro: V_cs_intros)
qed
(
auto
simp: cf_eval_gf cf_eval_g_cf_eval_f
intro: cf_eval_gf(2) cf_eval_g_cf_eval_f(2)
)
qed
lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_vcomp
lemma (in category) cat_cf_eval_arrow_ntcf_id[cat_cs_simps]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α" and "c ∈⇩∘ ℭ⦇Obj⦈"
shows
"cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈) =
cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈"
proof-
interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms)
from assms(2) have ntcf_id_CId_c:
"cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈) :
𝔉⦇ObjMap⦈⦇c⦈ ↦⇘cat_Set α⇙ 𝔉⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_intro: cat_cs_intros)
from assms(2) have CId_𝔉c:
"cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈ : 𝔉⦇ObjMap⦈⦇c⦈ ↦⇘cat_Set α⇙ 𝔉⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI[of α])
from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
"arr_Set α (cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈))"
by (auto dest: cat_Set_is_arrD(1))
from ntcf_id_CId_c have dom_lhs:
"𝒟⇩∘ (cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈) =
𝔉⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_simp: cat_cs_simps)+
interpret ntcf_id_CId_c:
arr_Set α ‹cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)›
by (rule arr_Set_ntcf_id_CId_c)
from CId_𝔉c show arr_Set_CId_𝔉c: "arr_Set α (cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈)"
by (auto dest: cat_Set_is_arrD(1))
from CId_𝔉c assms(2) have dom_rhs:
"𝒟⇩∘ ((cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈)⦇ArrVal⦈) = 𝔉⦇ObjMap⦈⦇c⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show
"cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈ =
cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ 𝔉⦇ObjMap⦈⦇c⦈"
with category_axioms assms(2) show
"cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈⦇a⦈ =
cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈⦇ArrVal⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_𝔉c in auto)
qed (use ntcf_id_CId_c CId_𝔉c in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id
subsection‹‹HOM›-functor›
subsubsection‹Definition and elementary properties›
text‹
The following definition is a technical generalization that is used
later in this section.
›
definition cf_HOM_snd :: "V ⇒ V ⇒ V" (‹HOM⇩Cı'(/,_-/')›)
where "HOM⇩C⇘α⇙(,𝔉-) =
[
(λa∈⇩∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(a,-) ∘⇩C⇩F 𝔉)),
(
λf∈⇩∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉)
),
op_cat (𝔉⦇HomCod⦈),
cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)
]⇩∘"
definition cf_HOM_fst :: "V ⇒ V ⇒ V" (‹HOM⇩Cı'(/_-,/')›)
where "HOM⇩C⇘α⇙(𝔉-,) =
[
(λa∈⇩∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(-,a) ∘⇩C⇩F op_cf 𝔉)),
(
λf∈⇩∘(𝔉⦇HomCod⦈)⦇Arr⦈.
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(-,f) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔉)
),
𝔉⦇HomCod⦈,
cat_FUNCT α (op_cat (𝔉⦇HomDom⦈)) (cat_Set α)
]⇩∘"
text‹Components.›
lemma cf_HOM_snd_components:
shows "HOM⇩C⇘α⇙(,𝔉-)⦇ObjMap⦈ =
(λa∈⇩∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(a,-) ∘⇩C⇩F 𝔉))"
and "HOM⇩C⇘α⇙(,𝔉-)⦇ArrMap⦈ =
(
λf∈⇩∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉)
)"
and [cat_cs_simps]: "HOM⇩C⇘α⇙(,𝔉-)⦇HomDom⦈ = op_cat (𝔉⦇HomCod⦈)"
and [cat_cs_simps]:
"HOM⇩C⇘α⇙(,𝔉-)⦇HomCod⦈ = cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)"
unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)
lemma cf_HOM_fst_components:
shows "HOM⇩C⇘α⇙(𝔉-,)⦇ObjMap⦈ =
(λa∈⇩∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(-,a) ∘⇩C⇩F op_cf 𝔉))"
and "HOM⇩C⇘α⇙(𝔉-,)⦇ArrMap⦈ =
(
λf∈⇩∘(𝔉⦇HomCod⦈)⦇Arr⦈.
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙(𝔉⦇HomCod⦈)(-,f) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔉)
)"
and "HOM⇩C⇘α⇙(𝔉-,)⦇HomDom⦈ = 𝔉⦇HomCod⦈"
and "HOM⇩C⇘α⇙(𝔉-,)⦇HomCod⦈ = cat_FUNCT α (op_cat (𝔉⦇HomDom⦈)) (cat_Set α)"
unfolding cf_HOM_fst_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas cf_HOM_snd_components' =
cf_HOM_snd_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]
lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
lemmas cf_HOM_fst_components' =
cf_HOM_fst_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]
lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
end
subsubsection‹Object map›
mk_VLambda cf_HOM_snd_components(1)
|vsv cf_HOM_snd_ObjMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_snd_components'(1)[unfolded cat_op_simps]
|vdomain cf_HOM_snd_ObjMap_vdomain[cat_cs_simps]|
|app cf_HOM_snd_ObjMap_app[cat_cs_simps]|
mk_VLambda cf_HOM_snd_components(1)
|vsv cf_HOM_fst_ObjMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_fst_components'(1)[unfolded cat_op_simps]
|vdomain cf_HOM_fst_ObjMap_vdomain[cat_cs_simps]|
|app cf_HOM_fst_ObjMap_app[cat_cs_simps]|
subsubsection‹Arrow map›
mk_VLambda cf_HOM_snd_components(2)
|vsv cf_HOM_snd_ArrMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_snd_components'(2)[unfolded cat_op_simps]
|vdomain cf_HOM_snd_ArrMap_vdomain[cat_cs_simps]|
|app cf_HOM_snd_ArrMap_app[cat_cs_simps]|
mk_VLambda cf_HOM_fst_components(2)
|vsv cf_HOM_fst_ArrMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_fst_components'(2)[unfolded cat_op_simps]
|vdomain cf_HOM_fst_ArrMap_vdomain[cat_cs_simps]|
|app cf_HOM_fst_ArrMap_app[cat_cs_simps]|
subsubsection‹Opposite ‹HOM›-functor›
lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]:
"HOM⇩C⇘α⇙(,op_cf 𝔉-) = HOM⇩C⇘α⇙(𝔉-,)"
proof-
have dom_lhs: "𝒟⇩∘ HOM⇩C⇘α⇙(,op_cf 𝔉-) = 4⇩ℕ"
unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
have dom_rhs: "𝒟⇩∘ HOM⇩C⇘α⇙(𝔉-,) = 4⇩ℕ"
unfolding cf_HOM_fst_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ 4⇩ℕ"
then show "HOM⇩C⇘α⇙(,op_cf 𝔉-)⦇a⦈ = HOM⇩C⇘α⇙(𝔉-,)⦇a⦈"
proof
(
elim_in_numeral,
use nothing in ‹fold dghm_field_simps, unfold cat_cs_simps›
)
show "HOM⇩C⇘α⇙(,op_cf 𝔉-)⦇ObjMap⦈ = HOM⇩C⇘α⇙(𝔉-,)⦇ObjMap⦈"
unfolding
cf_HOM_fst_components'
is_functor.cf_HOM_snd_components'[OF is_functor_op]
by (rule VLambda_eqI, unfold cat_op_simps)
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
)+
show "HOM⇩C⇘α⇙(,op_cf 𝔉-)⦇ArrMap⦈ = HOM⇩C⇘α⇙(𝔉-,)⦇ArrMap⦈"
unfolding
cf_HOM_fst_components'
is_functor.cf_HOM_snd_components'[OF is_functor_op]
by (rule VLambda_eqI, unfold cat_op_simps)
(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)+
qed
(
auto simp:
cf_HOM_fst_components' cat_cs_simps cat_op_simps cat_op_intros
)
qed (auto simp: cf_HOM_snd_def cf_HOM_fst_def)
qed
lemmas [cat_op_simps] = is_functor.cf_HOM_snd_op
context is_functor
begin
lemmas cf_HOM_fst_op[cat_op_simps] =
is_functor.cf_HOM_snd_op[OF is_functor_op, unfolded cat_op_simps, symmetric]
end
lemmas [cat_op_simps] = is_functor.cf_HOM_fst_op
subsubsection‹‹HOM›-functor is a functor›
lemma (in is_functor) cf_HOM_snd_is_functor:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "HOM⇩C⇘α⇙(,𝔉-) : op_cat 𝔅 ↦↦⇩C⇘β⇙ cat_FUNCT α 𝔄 (cat_Set α)"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret βℭ: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
show ?thesis
proof(intro is_functorI', unfold cat_op_simps)
show "vfsequence HOM⇩C⇘α⇙(,𝔉-)" unfolding cf_HOM_snd_def by auto
show "vcard HOM⇩C⇘α⇙(,𝔉-) = 4⇩ℕ"
unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (HOM⇩C⇘α⇙(,𝔉-)⦇ObjMap⦈) ⊆⇩∘ cat_FUNCT α 𝔄 (cat_Set α)⦇Obj⦈"
unfolding cf_HOM_snd_components'
proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
fix b assume prems: "b ∈⇩∘ 𝔅⦇Obj⦈"
with assms(2) show
"cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔅(b,-) ∘⇩C⇩F 𝔉) ∈⇩∘ cat_FUNCT α 𝔄 (cat_Set α)⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"HOM⇩C⇘α⇙(,𝔉-)⦇ArrMap⦈⦇f ∘⇩A⇘𝔅⇙ g⦈ =
HOM⇩C⇘α⇙(,𝔉-)⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_FUNCT α 𝔄 (cat_Set α)⇙
HOM⇩C⇘α⇙(,𝔉-)⦇ArrMap⦈⦇f⦈"
if "g : c ↦⇘𝔅⇙ b" and "f : b ↦⇘𝔅⇙ a" for b c g a f
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show
"HOM⇩C⇘α⇙(,𝔉-)⦇ArrMap⦈⦇𝔅⦇CId⦈⦇c⦈⦈ =
cat_FUNCT α 𝔄 (cat_Set α)⦇CId⦈⦇HOM⇩C⇘α⇙(,𝔉-)⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ 𝔅⦇Obj⦈" for c
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
use assms(2) in
‹
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
›
)+
qed
lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "ℭ' = op_cat 𝔅"
and "𝔇 = cat_FUNCT α 𝔄 (cat_Set α)"
shows "HOM⇩C⇘α⇙(,𝔉-) : ℭ' ↦↦⇩C⇘β⇙ 𝔇"
using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_snd_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_HOM_snd_is_functor'
lemma (in is_functor) cf_HOM_fst_is_functor:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "HOM⇩C⇘α⇙(𝔉-,) : 𝔅 ↦↦⇩C⇘β⇙ cat_FUNCT α (op_cat 𝔄) (cat_Set α)"
by
(
rule is_functor.cf_HOM_snd_is_functor[
OF is_functor_op assms, unfolded cat_op_simps
]
)
lemma (in is_functor) cf_HOM_fst_is_functor'[cat_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "ℭ' = 𝔅"
and "𝔇 = cat_FUNCT α (op_cat 𝔄) (cat_Set α)"
shows "HOM⇩C⇘α⇙(𝔉-,) : ℭ' ↦↦⇩C⇘β⇙ 𝔇"
using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_fst_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_HOM_fst_is_functor'
subsection‹Evaluation functor›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition cf_eval :: "V ⇒ V ⇒ V ⇒ V"
where "cf_eval α β ℭ =
[
(λ𝔉d∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈. 𝔉d⦇0⦈⦇ObjMap⦈⦇𝔉d⦇1⇩ℕ⦈⦈),
(
λ𝔑f∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Arr⦈.
cf_eval_arrow ℭ (𝔑f⦇0⦈) (𝔑f⦇1⇩ℕ⦈)
),
cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ,
cat_Set β
]⇩∘"
text‹Components.›
lemma cf_eval_components:
shows "cf_eval α β ℭ⦇ObjMap⦈ =
(λ𝔉d∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈. 𝔉d⦇0⦈⦇ObjMap⦈⦇𝔉d⦇1⇩ℕ⦈⦈)"
and "cf_eval α β ℭ⦇ArrMap⦈ =
(
λ𝔑f∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Arr⦈.
cf_eval_arrow ℭ (𝔑f⦇0⦈) (𝔑f⦇1⇩ℕ⦈)
)"
and [cat_cs_simps]:
"cf_eval α β ℭ⦇HomDom⦈ = cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ"
and [cat_cs_simps]: "cf_eval α β ℭ⦇HomCod⦈ = cat_Set β"
unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Object map›
lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval α β ℭ⦇ObjMap⦈)"
unfolding cf_eval_components by simp
lemma cf_eval_ObjMap_vdomain[cat_cs_simps]:
"𝒟⇩∘ (cf_eval α β ℭ⦇ObjMap⦈) = (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈"
unfolding cf_eval_components by simp
lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]:
assumes "𝔉c = [cf_map 𝔉, c]⇩∘"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows "cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈ = 𝔉⦇ObjMap⦈⦇c⦈"
proof-
interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms(2))
define β where "β = α + ω"
have "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
then interpret β: 𝒵 β by simp
note [cat_small_cs_intros] = cat_category_if_ge_Limit
from assms(2,3) αβ have "𝔉c ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈"
by
(
cs_concl cs_shallow
cs_simp: assms(1) cat_FUNCT_components(1)
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show ?thesis
by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.cf_eval_ObjMap_app
subsubsection‹Arrow map›
lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval α β ℭ⦇ArrMap⦈)"
unfolding cf_eval_components by simp
lemma cf_eval_ArrMap_vdomain[cat_cs_simps]:
"𝒟⇩∘ (cf_eval α β ℭ⦇ArrMap⦈) = (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Arr⦈"
unfolding cf_eval_components by simp
lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]:
assumes "𝔑f = [ntcf_arrow 𝔑, f]⇩∘"
and "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "f : a ↦⇘ℭ⇙ b"
shows "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ = cf_eval_arrow ℭ (ntcf_arrow 𝔑) f"
proof-
interpret 𝔉: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(2))
define β where "β = α + ω"
have "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
then interpret β: 𝒵 β by simp
note [cat_small_cs_intros] = cat_category_if_ge_Limit
from assms(1,3) αβ have "𝔑f ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Arr⦈"
by
(
cs_concl
cs_simp: assms(1) cat_FUNCT_components(1)
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show ?thesis
by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.cf_eval_ArrMap_app
subsubsection‹Evaluation functor is a functor›
lemma (in category) cat_cf_eval_is_functor:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "cf_eval α β ℭ : cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ ↦↦⇩C⇘β⇙ cat_Set β"
proof-
interpret β: 𝒵 β by (rule assms(1))
from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT:
category β ‹(cat_FUNCT α ℭ (cat_Set α))›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret βℭ: category β ℭ
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
by (rule subcategory_cat_Set_cat_Set[OF assms])
show ?thesis
proof(intro is_functorI')
show "vfsequence (cf_eval α β ℭ)" unfolding cf_eval_def by simp
from cat_category_if_ge_Limit[OF assms] show
"category β ((cat_FUNCT α ℭ (cat_Set α)) ×⇩C ℭ)"
by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
show "vcard (cf_eval α β ℭ) = 4⇩ℕ"
unfolding cf_eval_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (cf_eval α β ℭ⦇ObjMap⦈) ⊆⇩∘ cat_Set β⦇Obj⦈"
proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
fix 𝔉c assume prems: "𝔉c ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈"
then obtain 𝔉 c
where 𝔉c_def: "𝔉c = [𝔉, c]⇩∘"
and 𝔉: "𝔉 ∈⇩∘ cf_maps α ℭ (cat_Set α)"
and c: "c ∈⇩∘ ℭ⦇Obj⦈"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
intro: FUNCT.category_axioms βℭ.category_axioms
simp: cat_FUNCT_components(1)
)
from 𝔉 obtain 𝔊 where 𝔉_def: "𝔉 = cf_map 𝔊"
and 𝔊: "𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (elim cf_mapsE)
interpret 𝔊: is_functor α ℭ ‹cat_Set α› 𝔊 by (rule 𝔊)
from 𝔊 c show "cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈ ∈⇩∘ cat_Set β⦇Obj⦈"
unfolding 𝔉c_def 𝔉_def
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Set_αβ.subcat_Obj_vsubset
)
qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
show "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ :
cf_eval α β ℭ⦇ObjMap⦈⦇𝔉a⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔊b⦈"
if 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ 𝔊b" for 𝔉a 𝔊b 𝔑f
proof-
obtain 𝔑 f 𝔉 a 𝔊 b
where 𝔑f_def: "𝔑f = [𝔑, f]⇩∘"
and 𝔉a_def: "𝔉a = [𝔉, a]⇩∘"
and 𝔊b_def: "𝔊b = [𝔊, b]⇩∘"
and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊"
and f: "f : a ↦⇘ℭ⇙ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF 𝔑f]
FUNCT.category_axioms
βℭ.category_axioms
)
note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
from 𝔑(1) f assms(2) show "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ :
cf_eval α β ℭ⦇ObjMap⦈⦇𝔉a⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔊b⦈"
unfolding 𝔑f_def 𝔉a_def 𝔊b_def
by
(
intro cat_Set_αβ.subcat_is_arrD,
use nothing in ‹subst 𝔑(2), subst 𝔑(3), subst 𝔑(4)›
)
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros
)
qed
show
"cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g ∘⇩A⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ 𝔑f⦈ =
cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g⦈ ∘⇩A⇘cat_Set β⇙ cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈"
if 𝔐g: "𝔐g : 𝔊b ↦⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ ℌc"
and 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ 𝔊b"
for 𝔑f 𝔐g 𝔉a 𝔊b ℌc
proof-
obtain 𝔑 f 𝔉 a 𝔊 b
where 𝔑f_def: "𝔑f = [𝔑, f]⇩∘"
and 𝔉a_def: "𝔉a = [𝔉, a]⇩∘"
and 𝔊b_def: "𝔊b = [𝔊, b]⇩∘"
and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊"
and f: "f : a ↦⇘ℭ⇙ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF 𝔑f]
FUNCT.category_axioms
βℭ.category_axioms
)
then obtain 𝔐 g ℌ c
where 𝔐g_def: "𝔐g = [𝔐, g]⇩∘"
and ℌc_def: "ℌc = [ℌ, c]⇩∘"
and 𝔐: "𝔐 : 𝔊 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ℌ"
and g: "g : b ↦⇘ℭ⇙ c"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF 𝔐g]
FUNCT.category_axioms
βℭ.category_axioms
)
note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
and 𝔐 = cat_FUNCT_is_arrD[OF 𝔐]
from 𝔑(1) 𝔐(1) f g show
"cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g ∘⇩A⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ 𝔑f⦈ =
cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g⦈ ∘⇩A⇘cat_Set β⇙ cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈"
unfolding 𝔐g_def 𝔑f_def 𝔉a_def 𝔊b_def ℌc_def
by
(
subst (1 2) 𝔐(2), use nothing in ‹subst (1 2) 𝔑(2)›,
cs_concl_step cs_shallow cat_Set_αβ.subcat_Comp_simp[symmetric]
)
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
qed
show
"cf_eval α β ℭ⦇ArrMap⦈⦇(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇CId⦈⦇𝔉c⦈⦈ =
cat_Set β⦇CId⦈⦇cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈⦈"
if "𝔉c ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈" for 𝔉c
proof-
from that obtain 𝔉 c where 𝔉c_def: "𝔉c = [𝔉, c]⇩∘"
and 𝔉: "𝔉 ∈⇩∘ cf_maps α ℭ (cat_Set α)"
and c: "c ∈⇩∘ ℭ⦇Obj⦈"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
intro: FUNCT.category_axioms βℭ.category_axioms
simp: cat_FUNCT_components(1)
)
from 𝔉 obtain 𝔊 where 𝔉_def: "𝔉 = cf_map 𝔊"
and 𝔊: "𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (elim cf_mapsE)
interpret 𝔊: is_functor α ℭ ‹cat_Set α› 𝔊 by (rule 𝔊)
from 𝔊 c show
"cf_eval α β ℭ⦇ArrMap⦈⦇(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇CId⦈⦇𝔉c⦈⦈ =
cat_Set β⦇CId⦈⦇cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈⦈"
unfolding 𝔉c_def 𝔉_def
by (cs_concl_step cat_Set_αβ.subcat_CId[symmetric])
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
qed
qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_cf_eval_is_functor':
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔄' = cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ"
and "𝔅' = cat_Set β"
and "β' = β"
shows "cf_eval α β ℭ : 𝔄' ↦↦⇩C⇘β'⇙ 𝔅'"
using assms(1,2) unfolding assms(3-5) by (rule cat_cf_eval_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_eval_is_functor'
subsection‹‹N›-functor›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition cf_nt :: "V ⇒ V ⇒ V ⇒ V"
where "cf_nt α β 𝔉 =
bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))"
text‹Alternative definition.›
lemma (in is_functor) cf_nt_def':
"cf_nt α β 𝔉 =
bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))"
unfolding cf_nt_def cf_HomDom cf_HomCod by simp
text‹Components.›
lemma cf_nt_components:
shows "cf_nt α β 𝔉⦇ObjMap⦈ =
(
bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ObjMap⦈"
and "cf_nt α β 𝔉⦇ArrMap⦈ =
(
bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ArrMap⦈"
and "cf_nt α β 𝔉⦇HomDom⦈ =
(
bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇HomDom⦈"
and "cf_nt α β 𝔉⦇HomCod⦈ =
(
bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇HomCod⦈"
unfolding cf_nt_def by simp_all
lemma (in is_functor) cf_nt_components':
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "cf_nt α β 𝔉⦇ObjMap⦈ =
(
bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ObjMap⦈"
and "cf_nt α β 𝔉⦇ArrMap⦈ =
(
bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ArrMap⦈"
and [cat_cs_simps]:
"cf_nt α β 𝔉⦇HomDom⦈ = cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅"
and [cat_cs_simps]:
"cf_nt α β 𝔉⦇HomCod⦈ = cat_Set β"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
show
"cf_nt α β 𝔉⦇ObjMap⦈ =
(
bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ObjMap⦈"
"cf_nt α β 𝔉⦇ArrMap⦈ =
(
bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
(Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOM⇩C⇘α⇙(,𝔉-)-,-))
)⦇ArrMap⦈"
"cf_nt α β 𝔉⦇HomDom⦈ = cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅"
"cf_nt α β 𝔉⦇HomCod⦈ = cat_Set β"
unfolding cf_nt_def
using assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_components'(3,4)
subsubsection‹Object map›
lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt α β ℭ⦇ObjMap⦈)"
unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "𝒟⇩∘ (cf_nt α β 𝔉⦇ObjMap⦈) = (cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅)⦇Obj⦈"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
from assms(2) show ?thesis
unfolding cf_nt_components
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_vdomain
lemma (in is_functor) cf_nt_ObjMap_app[cat_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔊b = [cf_map 𝔊, b]⇩∘"
and "𝔊 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "cf_nt α β 𝔉⦇ObjMap⦈⦇𝔊b⦈ = Hom
(cat_FUNCT α 𝔄 (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔅(b,-) ∘⇩C⇩F 𝔉))
(cf_map 𝔊)"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret 𝔊: is_functor α 𝔄 ‹cat_Set α› 𝔊 by (rule assms(4))
from assms(2,5) show ?thesis
unfolding assms(3) cf_nt_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_app
subsubsection‹Arrow map›
lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt α β ℭ⦇ArrMap⦈)"
unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "𝒟⇩∘ (cf_nt α β 𝔉⦇ArrMap⦈) = (cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅)⦇Arr⦈"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
from assms(2) show ?thesis
unfolding cf_nt_components
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_vdomain
lemma (in is_functor) cf_nt_ArrMap_app[cat_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔑f = [ntcf_arrow 𝔑, f]⇩∘"
and "𝔑 : 𝔊 ↦⇩C⇩F ℌ : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
and "f : a ↦⇘𝔅⇙ b"
shows "cf_nt α β 𝔉⦇ArrMap⦈⦇𝔑f⦈ = cf_hom
(cat_FUNCT α 𝔄 (cat_Set α))
[ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔅(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉), ntcf_arrow 𝔑]⇩∘"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret 𝔑: is_ntcf α 𝔄 ‹cat_Set α› 𝔊 ℌ 𝔑 by (rule assms(4))
from assms(2,5) show ?thesis
unfolding assms(3) cf_nt_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_app
subsubsection‹‹N›-functor is a functor›
lemma (in is_functor) cf_nt_is_functor:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "cf_nt α β 𝔉 : cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅 ↦↦⇩C⇘β⇙ cat_Set β"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
from assms(2) show ?thesis
unfolding cf_nt_def'
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
qed
lemma (in is_functor) cf_nt_is_functor':
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔄' = cat_FUNCT α 𝔄 (cat_Set α) ×⇩C 𝔅"
and "𝔅' = cat_Set β"
and "β' = β"
shows "cf_nt α β 𝔉 : 𝔄' ↦↦⇩C⇘β'⇙ 𝔅'"
using assms(1,2) unfolding assms(3-5) by (rule cf_nt_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_nt_is_functor'
subsection‹Yoneda natural transformation arrow›
subsubsection‹Definition and elementary properties›
text‹
The following subsection is based on the elements of the content
of Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.
›
definition ntcf_Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_Yoneda_arrow α ℭ 𝔉 r =
[
(
λψ∈⇩∘Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-))) 𝔉.
Yoneda_map α (cf_of_cf_map ℭ (cat_Set α) 𝔉) r⦇
ntcf_of_ntcf_arrow ℭ (cat_Set α) ψ
⦈
),
Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-))) 𝔉,
𝔉⦇ObjMap⦈⦇r⦈
]⇩∘"
text‹Components›
lemma ntcf_Yoneda_arrow_components:
shows "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrVal⦈ =
(
λψ∈⇩∘Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-))) 𝔉.
Yoneda_map α (cf_of_cf_map ℭ (cat_Set α) 𝔉) r⦇
ntcf_of_ntcf_arrow ℭ (cat_Set α) ψ
⦈
)"
and [cat_cs_simps]: "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrDom⦈ =
Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-))) 𝔉"
and [cat_cs_simps]: "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrCod⦈ = 𝔉⦇ObjMap⦈⦇r⦈"
unfolding ntcf_Yoneda_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Arrow map›
mk_VLambda ntcf_Yoneda_arrow_components(1)
|vsv ntcf_Yoneda_arrow_vsv[cat_cs_intros]|
|vdomain ntcf_Yoneda_arrow_vdomain[cat_cs_simps]|
context category
begin
context
fixes 𝔉 :: V
begin
mk_VLambda ntcf_Yoneda_arrow_components(1)[where α=α and ℭ=ℭ and 𝔉=‹cf_map 𝔉›]
|app ntcf_Yoneda_arrow_app'|
lemmas ntcf_Yoneda_arrow_app =
ntcf_Yoneda_arrow_app'[unfolded in_Hom_iff, cat_cs_simps]
end
end
lemmas [cat_cs_simps] = category.ntcf_Yoneda_arrow_app
subsubsection‹Several technical lemmas›
lemma (in vsv) vsv_vrange_VLambda_app:
assumes "g ` elts A = elts (𝒟⇩∘ r)"
shows "ℛ⇩∘ (λx∈⇩∘A. r⦇g x⦈) = ℛ⇩∘ r"
proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
show "(λx∈⇩∘A. r⦇g x⦈)⦇x⦈ ∈⇩∘ ℛ⇩∘ r" if "x ∈⇩∘ A" for x
proof-
from assms that have "g x ∈⇩∘ 𝒟⇩∘ r" by auto
then have "r⦇g x⦈ ∈⇩∘ ℛ⇩∘ r" by force
with that show ?thesis by simp
qed
show "r⦇x⦈ ∈⇩∘ ℛ⇩∘ (λx∈⇩∘A. r⦇g x⦈)" if "x ∈⇩∘ 𝒟⇩∘ r" for x
proof-
from that assms have "x ∈ g ` elts A" by simp
then obtain c where c: "c ∈⇩∘ A" and x_def: "x = g c" by clarsimp
from c show ?thesis unfolding x_def by auto
qed
qed auto
lemma (in vsv) vsv_vrange_VLambda_app':
assumes "g ` elts A = elts (𝒟⇩∘ r)"
and "R = ℛ⇩∘ r"
shows "ℛ⇩∘ (λx∈⇩∘A. r⦇g x⦈) = R"
using assms(1) unfolding assms(2) by (rule vsv_vrange_VLambda_app)
lemma (in v11) v11_VLambda_v11_bij_betw_comp:
assumes "bij_betw g (elts A) (elts (𝒟⇩∘ r))"
shows "v11 (λx∈⇩∘A. r⦇g x⦈)"
proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
fix x y assume prems: "x ∈⇩∘ A" "y ∈⇩∘ A" "r⦇g x⦈ = r⦇g y⦈"
from assms prems(1,2) have "g x ∈⇩∘ 𝒟⇩∘ r" and "g y ∈⇩∘ 𝒟⇩∘ r" by auto
from v11_injective[OF this prems(3)] have "g x = g y".
with assms prems(1,2) show "x = y" unfolding bij_betw_def inj_on_def by simp
qed simp
subsubsection‹
Yoneda natural transformation arrow is an arrow in the category ‹Set›
›
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r :
Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)))
(cf_map 𝔉) ↦⇩i⇩s⇩o⇘cat_Set β⇙
𝔉⦇ObjMap⦈⦇r⦈"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms)
from assms(2) interpret FUNCT: tiny_category β ‹cat_FUNCT α ℭ (cat_Set α)›
by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
let ?Hom_r = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)›
from assms have [cat_cs_simps]: "cf_of_cf_map ℭ (cat_Set α) (cf_map 𝔉) = 𝔉"
by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
note Yoneda = cat_Yoneda_Lemma[OF assms(3,4)]
show ?thesis
proof
(
intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI,
unfold cat_cs_simps cf_map_components
)
show "vfsequence (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r)"
unfolding ntcf_Yoneda_arrow_def by simp
show "vcard (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r) = 3⇩ℕ"
unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈) = 𝔉⦇ObjMap⦈⦇r⦈"
unfolding cat_cs_simps cf_map_components ntcf_Yoneda_arrow_components
by (intro vsv.vsv_vrange_VLambda_app', unfold Yoneda(2))
(
use assms(4) in
‹
cs_concl cs_shallow
cs_simp:
cat_cs_simps bij_betwD(2)[OF bij_betw_ntcf_of_ntcf_arrow_Hom]
cs_intro: cat_cs_intros
›
)+
then show "ℛ⇩∘ (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈) ⊆⇩∘ 𝔉⦇ObjMap⦈⦇r⦈"
by auto
from assms(4) show "v11 (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈)"
unfolding ntcf_Yoneda_arrow_components
by
(
intro v11.v11_VLambda_v11_bij_betw_comp,
unfold cat_cs_simps 𝔉.Yoneda_map_vdomain;
intro Yoneda bij_betw_ntcf_of_ntcf_arrow_Hom
)
(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(4) show
"Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map ?Hom_r) (cf_map 𝔉) ∈⇩∘ Vset β"
by (intro FUNCT.cat_Hom_in_Vset)
(
cs_concl cs_shallow
cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from assms(4) have "𝔉⦇ObjMap⦈⦇r⦈ ∈⇩∘ Vset α"
by (cs_concl cs_intro: cat_cs_intros)
then show "𝔉⦇ObjMap⦈⦇r⦈ ∈⇩∘ Vset β"
by (auto simp: assms(2) Vset_trans Vset_in_mono)
qed (auto intro: cat_cs_intros)
qed
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism':
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔉' = cf_map 𝔉"
and "B = 𝔉⦇ObjMap⦈⦇r⦈"
and "A = Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)))
(cf_map 𝔉)"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_Yoneda_arrow α ℭ 𝔉' r : A ↦⇩i⇩s⇩o⇘cat_Set β⇙ B"
using assms(1,2,6,7)
unfolding assms(3-5)
by (rule cat_ntcf_Yoneda_arrow_is_arr_isomoprhism)
lemmas [cat_arrow_cs_intros] =
category.cat_ntcf_Yoneda_arrow_is_arr_isomoprhism'
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r :
Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)))
(cf_map 𝔉) ↦⇘cat_Set β⇙
𝔉⦇ObjMap⦈⦇r⦈"
by
(
rule cat_Set_is_iso_arrD[
OF cat_ntcf_Yoneda_arrow_is_arr_isomoprhism[OF assms]
]
)
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr'[cat_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔉' = cf_map 𝔉"
and "B = 𝔉⦇ObjMap⦈⦇r⦈"
and "A = Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)))
(cf_map 𝔉)"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_Yoneda_arrow α ℭ 𝔉' r : A ↦⇘cat_Set β⇙ B"
using assms(1,2,6,7)
unfolding assms(3-5)
by (rule cat_ntcf_Yoneda_arrow_is_arr)
lemmas [cat_arrow_cs_intros] = category.cat_ntcf_Yoneda_arrow_is_arr'
subsection‹Commutativity law for the Yoneda natural transformation arrow›
lemma (in category) cat_ntcf_Yoneda_arrow_commute:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "f : a ↦⇘ℭ⇙ b"
shows
"ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙
cf_hom
(cat_FUNCT α ℭ (cat_Set α))
[ntcf_arrow Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-), ntcf_arrow 𝔑]⇩∘ =
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a"
proof-
let ?hom =
‹
cf_hom
(cat_FUNCT α ℭ (cat_Set α))
[ntcf_arrow Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-), ntcf_arrow 𝔑]⇩∘
›
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(3))
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
interpret βℭ: category β ℭ
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
from assms(2,4) have 𝔊b_𝔑f:
"ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom :
Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)))
(cf_map 𝔉) ↦⇘cat_Set β⇙
𝔊⦇ObjMap⦈⦇b⦈"
by
(
cs_concl
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
cat_FUNCT_cs_intros
)
from assms(2,4) have 𝔑f_𝔉a:
"cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a :
Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)))
(cf_map 𝔉) ↦⇘cat_Set β⇙
𝔊⦇ObjMap⦈⦇b⦈"
by (cs_concl cs_intro: cat_cs_intros cat_Set_αβ.subcat_is_arrD)
show ?thesis
proof(rule arr_Set_eqI[of β])
from 𝔊b_𝔑f show arr_Set_𝔊b_𝔑f:
"arr_Set β (ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom)"
by (auto dest: cat_Set_is_arrD(1))
from 𝔊b_𝔑f have dom_lhs:
"𝒟⇩∘ ((ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈) =
Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)))
(cf_map 𝔉)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
interpret 𝔑f_𝔉a: arr_Set
β ‹ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom›
by (rule arr_Set_𝔊b_𝔑f)
from 𝔑f_𝔉a show arr_Set_𝔑f_𝔉a:
"arr_Set
β
(
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
)"
by (auto dest: cat_Set_is_arrD(1))
from 𝔑f_𝔉a have dom_rhs:
"𝒟⇩∘
(
(
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
)⦇ArrVal⦈
) = Hom
(cat_FUNCT α ℭ (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)))
(cf_map 𝔉)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show
"(ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈ =
(
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix 𝔐 assume prems:
"𝔐 : cf_map Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ cf_map 𝔉"
from assms(4) have [cat_cs_simps]:
"cf_of_cf_map ℭ (cat_Set α) (cf_map Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)) = Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
"cf_of_cf_map ℭ (cat_Set α) (cf_map 𝔉) = 𝔉"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note 𝔐 = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
interpret 𝔐: is_ntcf
α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)› 𝔉 ‹ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔐›
by (rule 𝔐(1))
have 𝔊𝔑_eq_𝔑𝔉:
"𝔊⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇A⦈⦈ =
𝔑⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇A⦈⦈"
if "A ∈⇩∘ 𝔉⦇ObjMap⦈⦇a⦈" for A
using
ArrVal_eq_helper[
OF 𝔑.ntcf_Comp_commute[OF assms(4), symmetric], where a=A
]
assms(4)
that
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from 𝔐(1) assms(2,3,4) have 𝔐a_CId_a:
"𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇a⦈⦈ ∈⇩∘ 𝔉⦇ObjMap⦈⦇a⦈"
by (subst 𝔐)
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_Set_cs_intros cat_cs_intros
)
have 𝔉f_𝔐a_eq_𝔐b:
"𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇h⦈⦈ =
𝔐⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f ∘⇩A⇘ℭ⇙ h⦈"
if "h : a ↦⇘ℭ⇙ a" for h
using
ArrVal_eq_helper[
OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric], where a=h
]
that
assms(4)
category_axioms
by
(
cs_prems cs_shallow
cs_simp:
cat_FUNCT_cs_simps
cat_map_extra_cs_simps
cat_cs_simps
cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from 𝔐(1) assms(2,3,4) 𝔐a_CId_a category_axioms show
"(ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘⇩A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈⦇𝔐⦈ =
(
cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
)⦇ArrVal⦈⦇𝔐⦈"
by (subst (1 2) 𝔐(2))
(
cs_concl
cs_simp:
𝔉f_𝔐a_eq_𝔐b 𝔊𝔑_eq_𝔑𝔉
cat_map_extra_cs_simps
cat_FUNCT_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Set_αβ.subcat_is_arrD
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed (use arr_Set_𝔊b_𝔑f arr_Set_𝔑f_𝔉a in auto)
qed (use 𝔊b_𝔑f 𝔑f_𝔉a in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
subsection‹Yoneda Lemma: naturality›
subsubsection‹
The Yoneda natural transformation: definition and elementary properties
›
text‹
The main result of this subsection corresponds to the corollary to the
Yoneda Lemma on page 61 in \<^cite>‹"mac_lane_categories_2010"›.
›
definition ntcf_Yoneda :: "V ⇒ V ⇒ V ⇒ V"
where "ntcf_Yoneda α β ℭ =
[
(
λ𝔉r∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈.
ntcf_Yoneda_arrow α ℭ (𝔉r⦇0⦈) (𝔉r⦇1⇩ℕ⦈)
),
cf_nt α β (cf_id ℭ),
cf_eval α β ℭ,
cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ,
cat_Set β
]⇩∘"
text‹Components.›
lemma ntcf_Yoneda_components:
shows "ntcf_Yoneda α β ℭ⦇NTMap⦈ =
(
λ𝔉r∈⇩∘(cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈.
ntcf_Yoneda_arrow α ℭ (𝔉r⦇0⦈) (𝔉r⦇1⇩ℕ⦈)
)"
and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTDom⦈ = cf_nt α β (cf_id ℭ)"
and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTCod⦈ = cf_eval α β ℭ"
and [cat_cs_simps]:
"ntcf_Yoneda α β ℭ⦇NTDGDom⦈ = cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ"
and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTDGCod⦈ = cat_Set β"
unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_Yoneda_components(1)
|vsv ntcf_Yoneda_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_Yoneda_NTMap_vdomain[cat_cs_intros]|
lemma (in category) ntcf_Yoneda_NTMap_app[cat_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔉r = [cf_map 𝔉, r]⇩∘"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "r ∈⇩∘ ℭ⦇Obj⦈"
shows "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ = ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms(4))
interpret βℭ: category β ℭ
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
from assms(2) interpret FUNCT: category β ‹cat_FUNCT α ℭ (cat_Set α)›
by
(
cs_concl cs_shallow
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms(5) have "[cf_map 𝔉, r]⇩∘ ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
then show ?thesis
unfolding assms(3) ntcf_Yoneda_components by (simp add: nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.ntcf_Yoneda_NTMap_app
subsubsection‹The Yoneda natural transformation is a natural transformation›
lemma (in category) cat_ntcf_Yoneda_is_ntcf:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "ntcf_Yoneda α β ℭ :
cf_nt α β (cf_id ℭ) ↦⇩C⇩F⇩.⇩i⇩s⇩o cf_eval α β ℭ :
cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ ↦↦⇩C⇘β⇙ cat_Set β"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret βℭ: category β ℭ
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
from assms(2) interpret FUNCT: category β ‹cat_FUNCT α ℭ (cat_Set α)›
by
(
cs_concl cs_shallow
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence (ntcf_Yoneda α β ℭ)" unfolding ntcf_Yoneda_def by simp
show "vcard (ntcf_Yoneda α β ℭ) = 5⇩ℕ"
unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
show ntcf_Yoneda_𝔉r: "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ :
cf_nt α β (cf_id ℭ)⦇ObjMap⦈⦇𝔉r⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔉r⦈"
if "𝔉r ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈" for 𝔉r
proof-
from that obtain 𝔉 r
where 𝔉r_def: "𝔉r = [𝔉, r]⇩∘"
and 𝔉: "𝔉 ∈⇩∘ cf_maps α ℭ (cat_Set α)"
and r: "r ∈⇩∘ ℭ⦇Obj⦈"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
simp: cat_FUNCT_cs_simps
intro: cat_cs_intros
)
from 𝔉 obtain 𝔊
where 𝔉_def: "𝔉 = cf_map 𝔊" and 𝔊: "𝔊 : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by clarsimp
from assms(2) 𝔊 r show ?thesis
unfolding 𝔉r_def 𝔉_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
)
qed
show "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ :
cf_nt α β (cf_id ℭ)⦇ObjMap⦈⦇𝔉r⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔉r⦈"
if "𝔉r ∈⇩∘ (cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ)⦇Obj⦈" for 𝔉r
by (rule is_iso_arrD[OF ntcf_Yoneda_𝔉r[OF that]])
show
"ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔊b⦈ ∘⇩A⇘cat_Set β⇙
cf_nt α β (cf_id ℭ)⦇ArrMap⦈⦇𝔑f⦈ =
cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ ∘⇩A⇘cat_Set β⇙
ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉a⦈"
if 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×⇩C ℭ⇙ 𝔊b" for 𝔉a 𝔊b 𝔑f
proof-
obtain 𝔑 f 𝔉 a 𝔊 b
where 𝔑f_def: "𝔑f = [𝔑, f]⇩∘"
and 𝔉a_def: "𝔉a = [𝔉, a]⇩∘"
and 𝔊b_def: "𝔊b = [𝔊, b]⇩∘"
and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊"
and f: "f : a ↦⇘ℭ⇙ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF 𝔑f]
FUNCT.category_axioms
βℭ.category_axioms
)
note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
note [cat_cs_simps] =
cat_ntcf_Yoneda_arrow_commute[OF assms 𝔑(1) f, folded 𝔑(2,3,4)]
from 𝔑(1) assms(2) f show ?thesis
unfolding 𝔑f_def 𝔉a_def 𝔊b_def
by (subst (1 2) 𝔑(2), use nothing in ‹subst 𝔑(3), subst 𝔑(4)›)
(
cs_concl
cs_simp: 𝔑(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
)+
qed
qed (use assms(2) in ‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›)+
qed
subsection‹‹Hom›-map›
text‹
This subsection presents some of the results stated as Corollary 2
in subsection 1.15 in \<^cite>‹"bodo_categories_1970"› and the corollary
following the statement of the Yoneda Lemma on
page 61 in \<^cite>‹"mac_lane_categories_2010"› in a variety of forms.
›
subsubsection‹Definition and elementary properties›
text‹
The following function makes an explicit appearance in subsection 1.15 in
\<^cite>‹"bodo_categories_1970"›.
›
definition ntcf_Hom_map :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_Hom_map α ℭ a b = (λf∈⇩∘Hom ℭ a b. Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-))"
text‹Elementary properties.›
mk_VLambda ntcf_Hom_map_def
|vsv ntcf_Hom_map_vsv|
|vdomain ntcf_Hom_map_vdomain[cat_cs_simps]|
|app ntcf_Hom_map_app[unfolded in_Hom_iff, cat_cs_simps]|
subsubsection‹‹Hom›-map is a bijection›
lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦⇘ℭ⇙ r"
and "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
and "⋀f. ⟦ f ∈⇩∘ ℭ⦇Arr⦈; 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ⟧ ⟹
f = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
proof-
interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)› 𝔑
by (rule assms(3))
let ?Y_Hom_s = ‹Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r›
note Yoneda =
cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
interpret Y: v11 ‹?Y_Hom_s› by (rule Yoneda(1))
from category_axioms assms have 𝔑_in_vdomain: "𝔑 ∈⇩∘ 𝒟⇩∘ (?Y_Hom_s)"
by (cs_concl cs_shallow cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
then have "?Y_Hom_s⦇𝔑⦈ ∈⇩∘ ℛ⇩∘ (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
from this category_axioms assms show Ym_𝔑: "?Y_Hom_s⦇𝔑⦈ : s ↦⇘ℭ⇙ r"
unfolding Yoneda(2)
by (cs_prems cs_shallow cs_simp: cat_cs_simps cat_op_simps)
then have "?Y_Hom_s⦇𝔑⦈ ∈⇩∘ ℭ⦇Arr⦈" by (simp add: cat_cs_intros)
have "Hom⇩A⇩.⇩C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (intro cat_ntcf_Hom_snd_is_ntcf Ym_𝔑)
from assms Ym_𝔑 this category_axioms assms have
"(?Y_Hom_s)¯⇩∘⦇?Y_Hom_s⦇𝔑⦈⦈ =
Yoneda_arrow α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r (?Y_Hom_s⦇𝔑⦈)"
by (intro category.inv_Yoneda_map_app)
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
then have "(?Y_Hom_s)¯⇩∘⦇?Y_Hom_s⦇𝔑⦈⦈ = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-)"
by (simp add: ntcf_Hom_snd_def'[OF Ym_𝔑])
with 𝔑_in_vdomain show "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-)" by auto
fix f assume prems: "f ∈⇩∘ ℭ⦇Arr⦈" "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
then obtain a b where f: "f : a ↦⇘ℭ⇙ b" by auto
have "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
with f 𝔑.ntcf_NTDom 𝔑.ntcf_NTCod assms cat_is_arrD(2,3)[OF f]
have ba_simps: "b = r" "a = s"
by
(
simp_all add:
prems(2) cat_cf_Hom_snd_inj cat_ntcf_Hom_snd_components(2,3)
)
from f have "f : s ↦⇘ℭ⇙ r" unfolding ba_simps .
with category_axioms show "f = ?Y_Hom_s⦇𝔑⦈"
unfolding prems(2)
by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_op_simps)
qed
lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique:
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈ : r ↦⇘ℭ⇙ s"
and "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈)"
and "⋀f. ⟦ f ∈⇩∘ ℭ⦇Arr⦈; 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) ⟧ ⟹
f = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈"
by
(
intro
category.cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[
OF category_op,
unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd,
OF assms(1,2),
unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
OF assms(3)
]
)+
lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique':
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "∃!f. f ∈⇩∘ ℭ⦇Arr⦈ ∧ 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
using cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms] by blast
lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique':
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "∃!f. f ∈⇩∘ ℭ⦇Arr⦈ ∧ 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)"
using cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique[OF assms] by blast
lemma (in category) cat_ntcf_Hom_snd_inj:
assumes "Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
and "g : a ↦⇘ℭ⇙ b"
and "f : a ↦⇘ℭ⇙ b"
shows "g = f"
proof-
from assms have
"Yoneda_map α (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)) b⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-)⦈ =
Yoneda_map α (Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)) b⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦈"
by simp
from this assms category_axioms show "g = f"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
simp
qed
lemma (in category) cat_ntcf_Hom_fst_inj:
assumes "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,g) = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)"
and "g : a ↦⇘ℭ⇙ b"
and "f : a ↦⇘ℭ⇙ b"
shows "g = f"
proof-
from category.cat_ntcf_Hom_snd_inj
[
OF category_op,
unfolded cat_op_simps,
unfolded cat_op_cat_ntcf_Hom_snd,
OF assms
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_map:
assumes "a ∈⇩∘ ℭ⦇Obj⦈" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "v11 (ntcf_Hom_map α ℭ a b)"
and "ℛ⇩∘ (ntcf_Hom_map α ℭ a b) =
these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
and "(ntcf_Hom_map α ℭ a b)¯⇩∘ =
(λ𝔑∈⇩∘these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-).
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈)"
proof-
show "v11 (ntcf_Hom_map α ℭ a b)"
proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
show "vsv (ntcf_Hom_map α ℭ a b)" unfolding ntcf_Hom_map_def by simp
fix g f assume prems:
"g : a ↦⇘ℭ⇙ b"
"f : a ↦⇘ℭ⇙ b"
"ntcf_Hom_map α ℭ a b⦇g⦈ = ntcf_Hom_map α ℭ a b⦇f⦈"
from prems(3,1,2) have "Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
with prems(1,2) show "g = f" by (intro cat_ntcf_Hom_snd_inj[of g f])
qed
then interpret Hm: v11 ‹ntcf_Hom_map α ℭ a b› .
show Hm_vrange: "ℛ⇩∘ (ntcf_Hom_map α ℭ a b) =
these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
proof(intro vsubset_antisym)
show "ℛ⇩∘ (ntcf_Hom_map α ℭ a b) ⊆⇩∘
these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
by
(
unfold ntcf_Hom_map_def,
intro vrange_VLambda_vsubset,
unfold these_ntcfs_iff in_Hom_iff,
intro cat_ntcf_Hom_snd_is_ntcf
)
show "these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ⊆⇩∘
ℛ⇩∘ (ntcf_Hom_map α ℭ a b)"
proof(intro vsubsetI, unfold these_ntcfs_iff)
fix 𝔑 assume prems:
"𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
note unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
from unique(1) have
"Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈ ∈⇩∘ 𝒟⇩∘ (ntcf_Hom_map α ℭ a b)"
by (cs_concl cs_simp: cat_cs_simps)
moreover from
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF assms(2,1) prems]
have 𝔑_def: "𝔑 = ntcf_Hom_map α ℭ a b⦇Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
ultimately show "𝔑 ∈⇩∘ ℛ⇩∘ (ntcf_Hom_map α ℭ a b)" by force
qed
qed
show "(ntcf_Hom_map α ℭ a b)¯⇩∘ =
(
λ𝔑∈⇩∘these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-).
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈
)"
proof
(
rule vsv_eqI,
unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
)
from Hm.v11_axioms show "vsv ((ntcf_Hom_map α ℭ a b)¯⇩∘)" by auto
show "vsv
(
λ𝔑∈⇩∘these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-).
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈
)"
by simp
fix 𝔑 assume prems:
"𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
then have 𝔑:
"𝔑 ∈⇩∘ these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
unfolding these_ntcfs_iff by simp
show "(ntcf_Hom_map α ℭ a b)¯⇩∘⦇𝔑⦈ =
(
λ𝔑∈⇩∘these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-).
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈
)⦇𝔑⦈"
proof
(
intro Hm.v11_vconverse_app,
unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF 𝔑]
)
note unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
show "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈ : a ↦⇘ℭ⇙ b" by (rule unique(1))
then show
"ntcf_Hom_map α ℭ a b⦇Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈⦈ = 𝔑"
by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
qed
qed simp
qed
subsubsection‹Inverse of a ‹Hom›-map›
lemma (in category) inv_ntcf_Hom_map_v11:
assumes "a ∈⇩∘ ℭ⦇Obj⦈" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "v11 ((ntcf_Hom_map α ℭ a b)¯⇩∘)"
using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_ntcf_Hom_map_vdomain:
assumes "a ∈⇩∘ ℭ⦇Obj⦈" and "b ∈⇩∘ ℭ⦇Obj⦈"
shows "𝒟⇩∘ ((ntcf_Hom_map α ℭ a b)¯⇩∘) =
these_ntcfs α ℭ (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-)"
unfolding cat_ntcf_Hom_map(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_vdomain
lemma (in category) inv_ntcf_Hom_map_app:
assumes "a ∈⇩∘ ℭ⦇Obj⦈"
and "b ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "(ntcf_Hom_map α ℭ a b)¯⇩∘⦇𝔑⦈ = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) b⦇𝔑⦈"
using assms(3) unfolding cat_ntcf_Hom_map(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_app
lemma inv_ntcf_Hom_map_vrange: "ℛ⇩∘ ((ntcf_Hom_map α ℭ a b)¯⇩∘) = Hom ℭ a b"
unfolding ntcf_Hom_map_def by simp
subsubsection‹‹Hom›-natural transformation and isomorphisms›
text‹
This subsection presents further results that were stated
as Corollary 2 in subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.
›
lemma (in category) cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf:
assumes "f : s ↦⇩i⇩s⇩o⇘ℭ⇙ r"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
from assms obtain g
where iso_g: "g : r ↦⇩i⇩s⇩o⇘ℭ⇙ s"
and gf: "g ∘⇩A⇘ℭ⇙ f = ℭ⦇CId⦈⦇s⦈"
and fg: "f ∘⇩A⇘ℭ⇙ g = ℭ⦇CId⦈⦇r⦈"
by
(
auto intro:
cat_the_inverse_Comp_CId_left
cat_the_inverse_Comp_CId_right
cat_the_inverse_is_iso_arr'
)
then have g: "g : r ↦⇘ℭ⇙ s" by auto
show ?thesis
proof(intro is_iso_arr_is_iso_ntcf)
from assms have f: "f : s ↦⇘ℭ⇙ r" by auto
with category_axioms show "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms g show "Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms f g have
"Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(g ∘⇩A⇘ℭ⇙ f,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms f g have "… = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
finally show
"Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
by simp
from category_axioms f g have
"Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f ∘⇩A⇘ℭ⇙ g,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms f g have "… = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
finally show
"Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
by simp
qed
qed
lemma (in category) cat_is_iso_arr_ntcf_Hom_fst_is_iso_ntcf:
assumes "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ s"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
from assms have r: "r ∈⇩∘ ℭ⦇Obj⦈" and s: "s ∈⇩∘ ℭ⦇Obj⦈" by auto
from
category.cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf
[
OF category_op,
unfolded cat_op_simps,
OF assms,
unfolded
category.cat_op_cat_cf_Hom_snd[OF category_axioms r]
category.cat_op_cat_cf_Hom_snd[OF category_axioms s]
category.cat_op_cat_ntcf_Hom_snd[OF category_axioms]
]
show ?thesis.
qed
lemma (in category) cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique:
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦⇩i⇩s⇩o⇘ℭ⇙ r"
and "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
and "⋀f. ⟦ f ∈⇩∘ ℭ⦇Arr⦈; 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ⟧ ⟹
f = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
proof-
let ?Ym_𝔑 = ‹Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈›
and ?Ym_inv_𝔑 = ‹Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) s⦇inv_ntcf 𝔑⦈›
from assms(3) have 𝔑:
"𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by auto
from iso_ntcf_is_iso_arr[OF assms(3)]
have iso_inv_𝔑: "inv_ntcf 𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and [simp]: "𝔑 ∙⇩N⇩T⇩C⇩F inv_ntcf 𝔑 = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
and [simp]: "inv_ntcf 𝔑 ∙⇩N⇩T⇩C⇩F 𝔑 = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
by auto
from iso_inv_𝔑 have inv_𝔑:
"inv_ntcf 𝔑 : Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by auto
note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) 𝔑]
and inv_unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_𝔑]
have Ym_𝔑: "?Ym_𝔑 : s ↦⇘ℭ⇙ r" by (rule unique(1))
show "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
and "⋀f. ⟦ f ∈⇩∘ ℭ⦇Arr⦈; 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ⟧ ⟹
f = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
by (intro unique)+
show "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦⇩i⇩s⇩o⇘ℭ⇙ r"
proof(intro is_iso_arrI[OF Ym_𝔑, of ‹?Ym_inv_𝔑›] is_inverseI)
show Ym_inv_𝔑: "?Ym_inv_𝔑 : r ↦⇘ℭ⇙ s" by (rule inv_unique(1))
have "ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) = 𝔑 ∙⇩N⇩T⇩C⇩F inv_ntcf 𝔑" by simp
also have "… = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_𝔑,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_inv_𝔑,-)"
by (subst unique(2), subst inv_unique(2)) simp
also from category_axioms Ym_𝔑 inv_unique(1) assms(3) have
"… = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_inv_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_𝔑,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
finally have "Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_inv_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_𝔑,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-)"
by simp
also from category_axioms assms(1,2) have "… = Hom⇩A⇩.⇩C⇘α⇙ℭ(ℭ⦇CId⦈⦇s⦈,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have "Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_inv_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_𝔑,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(ℭ⦇CId⦈⦇s⦈,-)"
by simp
then show "?Ym_inv_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_𝔑 = ℭ⦇CId⦈⦇s⦈"
by (rule cat_ntcf_Hom_snd_inj)
(
all‹
use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in
‹cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
›
)
have "ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) = inv_ntcf 𝔑 ∙⇩N⇩T⇩C⇩F 𝔑" by simp
also have "… = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_inv_𝔑,-) ∙⇩N⇩T⇩C⇩F Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_𝔑,-)"
by (subst unique(2), subst inv_unique(2)) simp
also from category_axioms Ym_𝔑 inv_unique(1) have
"… = Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_inv_𝔑,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
finally have
"Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_inv_𝔑,-) = ntcf_id Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-)"
by simp
also from category_axioms assms(1,2) have "… = Hom⇩A⇩.⇩C⇘α⇙ℭ(ℭ⦇CId⦈⦇r⦈,-)"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have
"Hom⇩A⇩.⇩C⇘α⇙ℭ(?Ym_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_inv_𝔑,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(ℭ⦇CId⦈⦇r⦈,-)"
by simp
then show "?Ym_𝔑 ∘⇩A⇘ℭ⇙ ?Ym_inv_𝔑 = ℭ⦇CId⦈⦇r⦈"
by (rule cat_ntcf_Hom_snd_inj)
(
all‹
use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in
‹cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
›
)
qed (intro Ym_𝔑)
qed
lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
assumes "r ∈⇩∘ ℭ⦇Obj⦈"
and "s ∈⇩∘ ℭ⦇Obj⦈"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈ : r ↦⇩i⇩s⇩o⇘ℭ⇙ s"
and "𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈)"
and "⋀f. ⟦ f ∈⇩∘ ℭ⦇Arr⦈; 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) ⟧ ⟹
f = Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇𝔑⦈"
by
(
intro
category.cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[
OF category_op,
unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd,
OF assms(1,2),
unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
OF assms(3)
]
)+
lemma (in category) cat_is_iso_arr_if_ntcf_Hom_snd_is_iso_ntcf:
assumes "f : s ↦⇘ℭ⇙ r"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "f : s ↦⇩i⇩s⇩o⇘ℭ⇙ r"
proof-
from assms(1) have r: "r ∈⇩∘ ℭ⦇Obj⦈" and s: "s ∈⇩∘ ℭ⦇Obj⦈" by auto
note unique = cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[OF r s assms(2)]
from unique(1) have Ym_Hf:
"Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(s,-) r⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)⦈ : s ↦⇘ℭ⇙ r"
by auto
from unique(1) show ?thesis
unfolding cat_ntcf_Hom_snd_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
by simp
qed
lemma (in category) cat_is_iso_arr_if_ntcf_Hom_fst_is_iso_ntcf:
assumes "f : r ↦⇘ℭ⇙ s"
and "Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ s"
proof-
from assms(1) have r: "r ∈⇩∘ ℭ⦇Obj⦈" and s: "s ∈⇩∘ ℭ⦇Obj⦈" by auto
note unique = cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique[OF r s assms(2)]
from unique(1) have Ym_Hf:
"Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(-,s) r⦇Hom⇩A⇩.⇩C⇘α⇙ℭ(-,f)⦈ : r ↦⇘ℭ⇙ s"
by auto
from unique(1) show ?thesis
unfolding cat_ntcf_Hom_fst_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
by simp
qed
subsubsection‹
The relationship between a ‹Hom›-natural transformation and the compositions
of a ‹Hom›-natural transformation and a natural transformation
›
lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⦇NTMap⦈⦇b, c⦈⇩∙ = Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈"
proof-
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
from assms(2) have b: "b ∈⇩∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp
from category_axioms assms(1,3) b show ?thesis
by
(
cs_concl cs_shallow
cs_simp:
cat_ntcf_lcomp_Hom_component_is_Yoneda_component cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
lemma (in category) cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F = Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)"
proof-
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
show ?thesis
proof(rule ntcf_eqI[of α])
from category_axioms assms show
"Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
from assms this have dom_lhs:
"𝒟⇩∘ ((Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show
"Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms this have dom_rhs:
"𝒟⇩∘ (Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"(Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈ =
Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ ℭ⦇Obj⦈"
with category_axioms assms show
"(Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈⦇a⦈ =
Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps)
qed (use assms(2) in ‹auto intro: cat_cs_intros›)
qed simp_all
qed
lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd
subsubsection‹
The relationship between the ‹Hom›-natural isomorphisms and the compositions
of a ‹Hom›-natural isomorphism and a natural transformation
›
lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "⋀b. b ∈⇩∘ 𝔅⦇Obj⦈ ⟹ Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
have "Hom⇩A⇩.⇩C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩C⇩F ↦⇩C⇩F⇩.⇩i⇩s⇩o
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)⇘op_cat 𝔅,ℭ⇙(b,-)⇩C⇩F :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
unfolding
cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1) that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTDom.is_functor_axioms that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTCod.is_functor_axioms that]
by (intro assms(2) that)
from
is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
OF
φ.NTDom.HomDom.category_op category_axioms
cat_ntcf_lcomp_Hom_is_ntcf[OF assms(1)],
unfolded cat_op_simps, OF this
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf:
assumes "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
from category_axioms assms show ?thesis
by
(
fold
cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1,3)]
cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTDom.is_functor_axioms assms(3)]
cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTCod.is_functor_axioms assms(3)],
intro bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf
)
(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed
subsection‹Yoneda map for arbitrary functors›
text‹
The concept of the Yoneda map for arbitrary functors was developed based
on the function that was used in the statement of Lemma 3 in
subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.
›
definition af_Yoneda_map :: "V ⇒ V ⇒ V ⇒ V"
where "af_Yoneda_map α 𝔉 𝔊 =
(λφ∈⇩∘these_ntcfs α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈) 𝔉 𝔊. Hom⇩A⇩.⇩C⇘α⇙(φ-,-))"
text‹Elementary properties.›
context
fixes α 𝔅 ℭ 𝔉 𝔊
assumes 𝔉: "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔊: "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule 𝔉)
interpretation 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule 𝔊)
mk_VLambda
af_Yoneda_map_def[where 𝔉=𝔉 and 𝔊=𝔊, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
|vsv af_Yoneda_map_vsv|
|vdomain af_Yoneda_map_vdomain[cat_cs_simps]|
|app af_Yoneda_map_app[unfolded these_ntcfs_iff, cat_cs_simps]|
end
subsection‹Yoneda arrow for arbitrary functors›
subsubsection‹Definition and elementary properties›
text‹
The following natural transformation is used in the proof of Lemma 3 in
subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.
›
definition af_Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "af_Yoneda_arrow α 𝔉 𝔊 𝔑 =
[
(
λb∈⇩∘(𝔉⦇HomDom⦈)⦇Obj⦈.
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
𝔑⇘op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈⇙(b,-)⇩N⇩T⇩C⇩F
⦈
),
𝔉,
𝔊,
𝔉⦇HomDom⦈,
𝔉⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma af_Yoneda_arrow_components:
shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈ =
(
λb∈⇩∘𝔉⦇HomDom⦈⦇Obj⦈.
Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
𝔑⇘op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈⇙(b,-)⇩N⇩T⇩C⇩F
⦈
)"
and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDom⦈ = 𝔉"
and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTCod⦈ = 𝔊"
and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDGCod⦈ = 𝔉⦇HomCod⦈"
unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda af_Yoneda_arrow_components(1)
|vsv af_Yoneda_arrow_NTMap_vsv|
context
fixes α 𝔅 ℭ 𝔉
assumes 𝔉: "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule 𝔉)
mk_VLambda
af_Yoneda_arrow_components(1)[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
|vdomain af_Yoneda_arrow_NTMap_vdomain[cat_cs_simps]|
|app af_Yoneda_arrow_NTMap_app[cat_cs_simps]|
end
lemma (in category) cat_af_Yoneda_arrow_is_ntcf:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
proof-
let ?H𝔊 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)›
and ?H𝔉 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)›
and ?Set = ‹cat_Set α›
and ?Ym =
‹
λb. Yoneda_map
α Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇𝔑⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F⦈
›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
interpret 𝔑: is_ntcf
α ‹op_cat 𝔅 ×⇩C ℭ› ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)› 𝔑
by (rule assms)
have comm[unfolded cat_op_simps]:
"(𝔑⦇NTMap⦈⦇c, d⦈⇩∙)⦇ArrVal⦈⦇f ∘⇩A⇘ℭ⇙ (q ∘⇩A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈)⦈ =
f ∘⇩A⇘ℭ⇙ ((𝔑⦇NTMap⦈⦇a, b⦈⇩∙)⦇ArrVal⦈⦇q⦈ ∘⇩A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇g⦈)"
if "g : a ↦⇘op_cat 𝔅⇙ c" and "f : b ↦⇘ℭ⇙ d" and "q : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b"
for q g f a b c d
proof-
from that(1) have g: "g : c ↦⇘𝔅⇙ a" unfolding cat_op_simps by simp
from category_axioms assms g that(2) have ab:
"[a, b]⇩∘ ∈⇩∘ (op_cat 𝔅 ×⇩C ℭ)⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
from 𝔑.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have 𝔑ab:
"𝔑⦇NTMap⦈⦇a, b⦈⇩∙ :
Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
have 𝔑_abq: "(𝔑⦇NTMap⦈⦇a, b⦈⇩∙)⦇ArrVal⦈⦇q⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b"
by
(
rule cat_Set_ArrVal_app_vrange[
OF 𝔑ab, unfolded in_Hom_iff, OF that(3)
]
)
have "[g, f]⇩∘ : [a, b]⇩∘ ↦⇘op_cat 𝔅 ×⇩C ℭ⇙ [c, d]⇩∘"
by
(
rule
cat_prod_2_is_arrI[
OF 𝔉.HomDom.category_op category_axioms that(1,2)
]
)
then have
"𝔑⦇NTMap⦈⦇c, d⦈⇩∙ ∘⇩A⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)⦇ArrMap⦈⦇g, f⦈⇩∙ =
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)⦇ArrMap⦈⦇g, f⦈⇩∙ ∘⇩A⇘cat_Set α⇙ 𝔑⦇NTMap⦈⦇a, b⦈⇩∙"
by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
then have
"(𝔑⦇NTMap⦈⦇c, d⦈⇩∙ ∘⇩A⇘?Set⇙ ?H𝔊⦇ArrMap⦈⦇g, f⦈⇩∙)⦇ArrVal⦈⦇q⦈ =
(?H𝔉⦇ArrMap⦈⦇g, f⦈⇩∙ ∘⇩A⇘?Set⇙ 𝔑⦇NTMap⦈⦇a, b⦈⇩∙)⦇ArrVal⦈⦇q⦈"
by auto
from
this that(2,3) assms
category_axioms 𝔉.HomDom.category_axioms 𝔉.HomDom.category_op category_op
g 𝔑ab 𝔑_abq
show
"(𝔑⦇NTMap⦈⦇c, d⦈⇩∙)⦇ArrVal⦈⦇f ∘⇩A⇘ℭ⇙ (q ∘⇩A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈)⦈ =
f ∘⇩A⇘ℭ⇙ ((𝔑⦇NTMap⦈⦇a, b⦈⇩∙)⦇ArrVal⦈⦇q⦈ ∘⇩A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇g⦈)"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (af_Yoneda_arrow α 𝔉 𝔊 𝔑)"
unfolding af_Yoneda_arrow_def by simp
show "vcard (af_Yoneda_arrow α 𝔉 𝔊 𝔑) = 5⇩ℕ"
unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)
have 𝔑b: "𝔑⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
by
(
rule
bnt_proj_snd_is_ntcf
[
OF 𝔉.HomDom.category_op category_axioms assms(3),
unfolded cat_op_simps,
OF that,
unfolded
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) that]
]
)
show "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
proof-
let ?𝔊b = ‹𝔊⦇ObjMap⦈⦇b⦈›
and ?𝔉b = ‹𝔉⦇ObjMap⦈⦇b⦈›
and ?ℭ𝔊b = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈›
from that have ℭ𝔊b: "?ℭ𝔊b : ?𝔊b ↦⇘ℭ⇙ ?𝔊b" by (auto simp: cat_cs_intros)
from assms that have "[b, ?𝔊b]⇩∘ ∈⇩∘ (op_cat 𝔅 ×⇩C ℭ)⦇Obj⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_b𝔊b:
"𝔑⦇NTMap⦈⦇b, ?𝔊b⦈⇩∙ : Hom ℭ ?𝔊b ?𝔊b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉b ?𝔊b"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from ℭ𝔊b have 𝔑_b𝔊b_ℭ𝔊b:
"(𝔑⦇NTMap⦈⦇b, ?𝔊b⦈⇩∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ : ?𝔉b ↦⇘ℭ⇙ ?𝔊b"
by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_b𝔊b, unfolded in_Hom_iff])
with category_axioms assms that 𝔑b[OF that] show ?thesis
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
qed
show
"af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇f⦈ =
𝔊⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘𝔅⇙ b" for a b f
proof-
from that have a: "a ∈⇩∘ 𝔅⦇Obj⦈" and b: "b ∈⇩∘ 𝔅⦇Obj⦈" by auto
let ?𝔅a = ‹𝔅⦇CId⦈⦇a⦈›
and ?𝔅b = ‹𝔅⦇CId⦈⦇b⦈›
and ?𝔊a = ‹𝔊⦇ObjMap⦈⦇a⦈›
and ?𝔊b = ‹𝔊⦇ObjMap⦈⦇b⦈›
and ?𝔉a = ‹𝔉⦇ObjMap⦈⦇a⦈›
and ?𝔉b = ‹𝔉⦇ObjMap⦈⦇b⦈›
and ?ℭ𝔊a = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈›
and ?ℭ𝔊b = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈›
from that have ℭ𝔊a: "?ℭ𝔊a : ?𝔊a ↦⇘ℭ⇙ ?𝔊a" by (auto intro: cat_cs_intros)
from that have ℭ𝔊b: "?ℭ𝔊b : ?𝔊b ↦⇘ℭ⇙ ?𝔊b" by (auto intro: cat_cs_intros)
from that have 𝔅a: "?𝔅a : a ↦⇘𝔅⇙ a" by (auto intro: cat_cs_intros)
from assms that have "[b, ?𝔊b]⇩∘ ∈⇩∘ (op_cat 𝔅 ×⇩C ℭ)⦇Obj⦈"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_b𝔊b:
"𝔑⦇NTMap⦈⦇b, ?𝔊b⦈⇩∙ : Hom ℭ ?𝔊b ?𝔊b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉b ?𝔊b"
by
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from ℭ𝔊b have 𝔑_b𝔊b_ℭ𝔊b:
"(𝔑⦇NTMap⦈⦇b, ?𝔊b⦈⇩∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ : ?𝔉b ↦⇘ℭ⇙ ?𝔊b"
by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_b𝔊b, unfolded in_Hom_iff])
from assms that have "[a, ?𝔊a]⇩∘ ∈⇩∘ (op_cat 𝔅 ×⇩C ℭ)⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_a𝔊a:
"𝔑⦇NTMap⦈⦇a, ?𝔊a⦈⇩∙ : Hom ℭ ?𝔊a ?𝔊a ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a ?𝔊a"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from ℭ𝔊a have 𝔑_a𝔊a_ℭ𝔊a:
"(𝔑⦇NTMap⦈⦇a, ?𝔊a⦈⇩∙)⦇ArrVal⦈⦇?ℭ𝔊a⦈ : ?𝔉a ↦⇘ℭ⇙ ?𝔊a"
by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_a𝔊a, unfolded in_Hom_iff])
from
comm[OF 𝔅a 𝔊.cf_ArrMap_is_arr[OF that] ℭ𝔊a]
category_axioms assms that 𝔑_a𝔊a_ℭ𝔊a
have 𝔑_a_𝔊b[symmetric, cat_cs_simps]:
"(𝔑⦇NTMap⦈⦇a, ?𝔊b⦈⇩∙)⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦈ =
𝔊⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (𝔑⦇NTMap⦈⦇a, ?𝔊a⦈⇩∙)⦇ArrVal⦈⦇?ℭ𝔊a⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from comm[OF that ℭ𝔊b ℭ𝔊b] category_axioms assms that 𝔑_b𝔊b_ℭ𝔊b
have 𝔑_a_𝔊b'[cat_cs_simps]:
"(𝔑⦇NTMap⦈⦇a, ?𝔊b⦈⇩∙)⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦈ =
(𝔑⦇NTMap⦈⦇b, ?𝔊b⦈⇩∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ ∘⇩A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇f⦈"
by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms that 𝔑b[OF a] 𝔑b[OF b] show ?thesis
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
qed
qed (auto simp: af_Yoneda_arrow_components cat_cs_simps intro: cat_cs_intros)
qed
lemma (in category) cat_af_Yoneda_arrow_is_ntcf':
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "β = α"
and "𝔉' = 𝔉"
and "𝔊' = 𝔊"
shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅 ↦↦⇩C⇘β⇙ ℭ"
using assms(1-3) unfolding assms(4-6) by (rule cat_af_Yoneda_arrow_is_ntcf)
lemmas [cat_cs_intros] = category.cat_af_Yoneda_arrow_is_ntcf'
subsubsection‹Yoneda Lemma for arbitrary functors›
text‹
The following lemmas correspond to variants of the elements of Lemma 3
in subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.
›
lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "𝔑 = Hom⇩A⇩.⇩C⇘α⇙(af_Yoneda_arrow α 𝔉 𝔊 𝔑-,-)"
proof-
let ?H𝔊 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)›
and ?H𝔉 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)›
and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
interpret 𝔑: is_ntcf α ‹op_cat 𝔅 ×⇩C ℭ› ‹cat_Set α› ‹?H𝔊› ‹?H𝔉› 𝔑
by (rule assms(3))
interpret aY𝔑: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ‹?aYa 𝔑›
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
interpret HY𝔑: is_ntcf
α ‹op_cat 𝔅 ×⇩C ℭ› ‹cat_Set α› ‹?H𝔊› ‹?H𝔉› ‹Hom⇩A⇩.⇩C⇘α⇙(?aYa 𝔑-,-)›
by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aY𝔑.is_ntcf_axioms])
show [cat_cs_simps]: "𝔑 = Hom⇩A⇩.⇩C⇘α⇙(?aYa 𝔑-,-)"
proof
(
rule sym,
rule ntcf_eqI[OF HY𝔑.is_ntcf_axioms assms(3)],
rule vsv_eqI;
(intro HY𝔑.NTMap.vsv_axioms 𝔑.NTMap.vsv_axioms)?;
(unfold 𝔑.ntcf_NTMap_vdomain HY𝔑.ntcf_NTMap_vdomain)?
)
fix bc assume prems': "bc ∈⇩∘ (op_cat 𝔅 ×⇩C ℭ)⦇Obj⦈"
then obtain b c
where bc_def: "bc = [b, c]⇩∘"
and op_b: "b ∈⇩∘ op_cat 𝔅⦇Obj⦈"
and c: "c ∈⇩∘ ℭ⦇Obj⦈"
by (auto intro: cat_prod_2_ObjE cat_cs_intros)
from op_b have b: "b ∈⇩∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp
then have 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
by (auto intro: cat_cs_intros)
have Ym_𝔑:
"Yoneda_map α Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
𝔑⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F
⦈ = ?aYa 𝔑⦇NTMap⦈⦇b⦈"
unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp
from
bnt_proj_snd_is_ntcf
[
OF 𝔉.HomDom.category_op category_axioms assms(3) op_b,
unfolded
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) b]
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) b]
]
have 𝔑b: "𝔑⇘op_cat 𝔅,ℭ⇙(b,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by simp
from c show "Hom⇩A⇩.⇩C⇘α⇙(?aYa 𝔑-,-)⦇NTMap⦈⦇bc⦈ = 𝔑⦇NTMap⦈⦇bc⦈"
unfolding
bc_def
cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aY𝔑.is_ntcf_axioms b c]
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
OF 𝔊b 𝔉b 𝔑b, unfolded Ym_𝔑, symmetric
]
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
qed simp_all
qed
lemma (in category) cat_af_Yoneda_Lemma:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "v11 (af_Yoneda_map α 𝔉 𝔊)"
and "ℛ⇩∘ (af_Yoneda_map α 𝔉 𝔊) =
these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)"
and "(af_Yoneda_map α 𝔉 𝔊)¯⇩∘ =
(
λ𝔑∈⇩∘these_ntcfs
α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-).
af_Yoneda_arrow α 𝔉 𝔊 𝔑
)"
proof-
let ?H𝔊 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)›
and ?H𝔉 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)›
and ?aYm = ‹af_Yoneda_map α 𝔉 𝔊›
and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
show v11_aY: "v11 ?aYm"
proof
(
intro vsv.vsv_valeq_v11I,
unfold af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
)
show "vsv (af_Yoneda_map α 𝔉 𝔊)" by (rule af_Yoneda_map_vsv[OF assms])
fix φ ψ assume prems:
"φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
"ψ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
"?aYm⦇φ⦈ = ?aYm⦇ψ⦈"
interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule prems(1))
interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule prems(2))
from prems(3) have Hφ_Hψ: "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) = Hom⇩A⇩.⇩C⇘α⇙(ψ-,-)"
unfolding
af_Yoneda_map_app[OF assms prems(1)]
af_Yoneda_map_app[OF assms prems(2)]
by simp
show "φ = ψ"
proof
(
rule ntcf_eqI[OF prems(1,2)],
rule vsv_eqI,
unfold φ.ntcf_NTMap_vdomain ψ.ntcf_NTMap_vdomain
)
fix b assume prems': "b ∈⇩∘ 𝔅⦇Obj⦈"
from prems' have φb: "φ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
and ψb: "ψ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
and 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
by (auto intro: cat_cs_intros cat_prod_cs_intros)
have "Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)"
proof
(
rule
ntcf_eqI
[
OF
cat_ntcf_Hom_snd_is_ntcf[OF φb]
cat_ntcf_Hom_snd_is_ntcf[OF ψb]
]
)
show "Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈ = Hom⇩A⇩.⇩C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈"
proof
(
rule vsv_eqI,
unfold
ntcf_Hom_snd_NTMap_vdomain[OF φb]
ntcf_Hom_snd_NTMap_vdomain[OF ψb]
)
fix c assume prems'': "c ∈⇩∘ ℭ⦇Obj⦈"
note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
show
"Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈ =
Hom⇩A⇩.⇩C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈"
unfolding
H[OF prems(1) prems' prems'', symmetric]
H[OF prems(2) prems' prems'', symmetric]
Hφ_Hψ
by simp
qed
(
simp_all add:
ntcf_Hom_snd_NTMap_vsv[OF ψb] ntcf_Hom_snd_NTMap_vsv[OF φb]
)
qed simp_all
with φb ψb show "φ⦇NTMap⦈⦇b⦈ = ψ⦇NTMap⦈⦇b⦈"
by (auto intro: cat_ntcf_Hom_snd_inj)
qed auto
qed
interpret aYm: v11 ?aYm by (rule v11_aY)
have [cat_cs_simps]: "?aYm⦇?aYa 𝔑⦈ = 𝔑"
if "𝔑 : ?H𝔊 ↦⇩C⇩F ?H𝔉 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α" for 𝔑
using category_axioms assms that
by
(
cs_concl cs_shallow
cs_simp:
cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric] cat_cs_simps
cs_intro: cat_cs_intros
)
show aYm_vrange:
"ℛ⇩∘ ?aYm = these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉"
proof(intro vsubset_antisym)
show "ℛ⇩∘ ?aYm ⊆⇩∘ these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
)
fix φ assume "φ : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
with category_axioms assms show
"?aYm⦇φ⦈ : ?H𝔊 ↦⇩C⇩F ?H𝔉 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: af_Yoneda_map_vsv)
show "these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉 ⊆⇩∘ ℛ⇩∘ ?aYm"
proof(rule vsubsetI, unfold these_ntcfs_iff)
fix 𝔑 assume prems:
"𝔑 : ?H𝔊 ↦⇩C⇩F ?H𝔉 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
interpret aY𝔑: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ‹?aYa 𝔑›
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
from prems have 𝔑_def: "𝔑 = ?aYm⦇?aYa 𝔑⦈"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
from assms aY𝔑.is_ntcf_axioms have "?aYa 𝔑 ∈⇩∘ 𝒟⇩∘ ?aYm"
by (cs_concl cs_shallow cs_simp: these_ntcfs_iff cat_cs_simps)
then show "𝔑 ∈⇩∘ ℛ⇩∘ ?aYm" by (subst 𝔑_def, intro aYm.vsv_vimageI2) auto
qed
qed
show "?aYm¯⇩∘ =
(λ𝔑∈⇩∘these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉. ?aYa 𝔑)"
proof
(
rule vsv_eqI,
unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
)
from aYm.v11_axioms show "vsv ((af_Yoneda_map α 𝔉 𝔊)¯⇩∘)" by auto
fix 𝔑 assume prems: "𝔑 : ?H𝔊 ↦⇩C⇩F ?H𝔉 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
then have 𝔑: "𝔑 ∈⇩∘ these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉"
by simp
show "?aYm¯⇩∘⦇𝔑⦈ =
(λ𝔑∈⇩∘these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) ?H𝔊 ?H𝔉. ?aYa 𝔑)⦇𝔑⦈"
proof
(
intro aYm.v11_vconverse_app,
unfold beta[OF 𝔑] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
)
from prems show 𝔑_def: "?aYm⦇?aYa 𝔑⦈ = 𝔑"
by (cs_concl cs_shallow cs_simp: cat_cs_simps)
show "?aYa 𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
qed
qed simp_all
qed
subsubsection‹Inverse of the Yoneda map for arbitrary functors›
lemma (in category) inv_af_Yoneda_map_v11:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "v11 ((af_Yoneda_map α 𝔉 𝔊)¯⇩∘)"
using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_af_Yoneda_map_vdomain:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "𝒟⇩∘ ((af_Yoneda_map α 𝔉 𝔊)¯⇩∘) =
these_ntcfs α (op_cat 𝔅 ×⇩C ℭ) (cat_Set α) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)"
unfolding cat_af_Yoneda_Lemma(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_vdomain
lemma (in category) inv_af_Yoneda_map_app:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "(af_Yoneda_map α 𝔉 𝔊)¯⇩∘⦇𝔑⦈ = af_Yoneda_arrow α 𝔉 𝔊 𝔑"
using assms(3) unfolding cat_af_Yoneda_Lemma(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_app
lemma (in category) inv_af_Yoneda_map_vrange:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "ℛ⇩∘ ((af_Yoneda_map α 𝔉 𝔊)¯⇩∘) = these_ntcfs α 𝔅 ℭ 𝔉 𝔊"
proof-
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
from assms show ?thesis
unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
qed
subsubsection‹Yoneda map for arbitrary functors and natural isomorphisms›
text‹
The following lemmas correspond to variants of the elements of
Lemma 3 in subsection 1.15 in \<^cite>‹"bodo_categories_1970"›.
›
lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
assumes "φ : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret φ: is_iso_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
show ?thesis
proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
fix b assume "b ∈⇩∘ 𝔅⦇Obj⦈"
then show "Hom⇩A⇩.⇩C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by
(
auto intro!:
cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
)
qed (auto simp: cat_cs_intros)
qed
lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf':
assumes "φ : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "β = α"
and "𝔊' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)"
and "𝔉' = Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)"
and "𝔅' = op_cat 𝔅 ×⇩C ℭ"
and "ℭ' = cat_Set α"
shows "Hom⇩A⇩.⇩C⇘α⇙(φ-,-) : 𝔊' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔉' : 𝔅' ↦↦⇩C⇘β⇙ ℭ'"
using assms(1)
unfolding assms(2-6)
by (rule cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf)
lemmas [cat_cs_intros] =
category.cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf'
lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
proof-
let ?aYa = ‹af_Yoneda_arrow α 𝔉 𝔊 𝔑›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
interpret 𝔑: is_iso_ntcf
α ‹op_cat 𝔅 ×⇩C ℭ› ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)› 𝔑
by (rule assms(3))
from assms(1,2) 𝔑.is_ntcf_axioms have 𝔑_def: "𝔑 = Hom⇩A⇩.⇩C⇘α⇙(?aYa-,-)"
by
(
cs_concl cs_shallow
cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric]
)
from category_axioms assms have aYa: "?aYa : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_shallow cs_intro: cat_cs_intros)
have Hom_aYa: "Hom⇩A⇩.⇩C⇘α⇙(?aYa-,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (auto intro: assms(3) simp add: 𝔑_def[symmetric])
have Hb:
"Hom⇩A⇩.⇩C⇘α⇙ℭ(?aYa⦇NTMap⦈⦇b⦈,-) :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
ℭ ↦↦⇩C⇘α⇙ cat_Set α"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
by
(
rule cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf[
OF aYa Hom_aYa that
]
)
show ?thesis
proof(intro is_iso_ntcfI)
from category_axioms assms show
"af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦⇩C⇩F 𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix b assume prems: "b ∈⇩∘ 𝔅⦇Obj⦈"
then have 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
by (auto intro: cat_cs_intros)
from assms(1,2) aYa prems have aYa_b:
"?aYa⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
by (cs_concl cs_shallow cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
show "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇩i⇩s⇩o⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
by
(
rule cat_is_iso_arr_if_ntcf_Hom_snd_is_iso_ntcf[
OF aYa_b Hb[OF prems]
]
)
qed
qed
lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf':
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) :
op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
and "β = α"
and "𝔉' = 𝔉"
and "𝔊' = 𝔊"
shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊' : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf)
lemmas [cat_cs_intros] =
category.cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf'
lemma (in category) cat_iso_functor_if_cf_lcomp_Hom_iso_functor:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) ≈⇩C⇩F⇘α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)"
shows "𝔉 ≈⇩C⇩F⇘α⇙ 𝔊"
proof-
let ?H𝔊 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)›
and ?H𝔉 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)›
and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
from assms(3) obtain 𝔑 𝔄 𝔇 where 𝔑: "𝔑 : ?H𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o ?H𝔊 : 𝔄 ↦↦⇩C⇘α⇙ 𝔇"
by auto
interpret 𝔑: is_iso_ntcf α 𝔄 𝔇 ?H𝔉 ?H𝔊 𝔑 by (rule 𝔑)
from category_axioms assms have "?H𝔉 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have 𝔄_def: "𝔄 = op_cat 𝔅 ×⇩C ℭ" and 𝔇_def: "𝔇 = cat_Set α"
by (force simp: cat_cs_simps)+
note 𝔑 = 𝔑[unfolded 𝔄_def 𝔇_def]
from 𝔑 have "𝔑 : ?H𝔉 ↦⇩C⇩F ?H𝔊 : op_cat 𝔅 ×⇩C ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros
)
from category_axioms assms 𝔑 have
"af_Yoneda_arrow α 𝔊 𝔉 𝔑 : 𝔊 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have "𝔊 ≈⇩C⇩F⇘α⇙ 𝔉" by (clarsimp intro!: iso_functorI)
then show ?thesis by (rule iso_functor_sym)
qed
lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor:
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔉 ≈⇩C⇩F⇘α⇙ 𝔊"
shows "Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) ≈⇩C⇩F⇘α⇙ Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)"
proof-
let ?H𝔊 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔊-,-)›
and ?H𝔉 = ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-)›
and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
from assms obtain 𝔅' ℭ' φ where φ: "φ : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔅' ↦↦⇩C⇘α⇙ ℭ'"
by auto
interpret φ: is_iso_ntcf α 𝔅' ℭ' 𝔉 𝔊 φ by (rule φ)
from assms φ.NTDom.is_functor_axioms
have 𝔅'_def: "𝔅' = 𝔅" and ℭ'_def: "ℭ' = ℭ"
by fast+
note φ = φ[unfolded 𝔅'_def ℭ'_def]
show ?thesis
by (rule iso_functor_sym)
(
intro iso_functorI[
OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF φ]
]
)
qed
lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
assumes "𝔉 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔉 ≈⇩C⇩F⇘α⇙ 𝔊"
and "α' = α"
and "ℭ' = ℭ"
shows "Hom⇩O⇩.⇩C⇘α⇙ℭ(𝔉-,-) ≈⇩C⇩F⇘α⇙ Hom⇩O⇩.⇩C⇘α'⇙ℭ'(𝔊-,-)"
using assms(1-3)
unfolding assms(4,5)
by (rule cat_cf_lcomp_Hom_iso_functor_if_iso_functor)
lemmas [cat_cs_intros] =
category.cat_cf_lcomp_Hom_iso_functor_if_iso_functor'
subsection‹The Yoneda Functor›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition Yoneda_functor :: "V ⇒ V ⇒ V"
where "Yoneda_functor α 𝔇 =
[
(λr∈⇩∘op_cat 𝔇⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔇(r,-))),
(λf∈⇩∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔇(f,-))),
op_cat 𝔇,
cat_FUNCT α 𝔇 (cat_Set α)
]⇩∘"
text‹Components.›
lemma Yoneda_functor_components:
shows "Yoneda_functor α 𝔇⦇ObjMap⦈ =
(λr∈⇩∘op_cat 𝔇⦇Obj⦈. cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔇(r,-)))"
and "Yoneda_functor α 𝔇⦇ArrMap⦈ =
(λf∈⇩∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔇(f,-)))"
and "Yoneda_functor α 𝔇⦇HomDom⦈ = op_cat 𝔇"
and "Yoneda_functor α 𝔇⦇HomCod⦈ = cat_FUNCT α 𝔇 (cat_Set α)"
unfolding Yoneda_functor_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Object map›
mk_VLambda Yoneda_functor_components(1)
|vsv Yoneda_functor_ObjMap_vsv[cat_cs_intros]|
|vdomain Yoneda_functor_ObjMap_vdomain[cat_cs_simps]|
|app Yoneda_functor_ObjMap_app[cat_cs_simps]|
lemma (in category) Yoneda_functor_ObjMap_vrange:
"ℛ⇩∘ (Yoneda_functor α ℭ⦇ObjMap⦈) ⊆⇩∘ cat_FUNCT α ℭ (cat_Set α)⦇Obj⦈"
proof
(
unfold Yoneda_functor_components,
rule vrange_VLambda_vsubset,
unfold cat_op_simps
)
fix c assume "c ∈⇩∘ ℭ⦇Obj⦈"
with category_axioms show
"cf_map Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∈⇩∘ cat_FUNCT α ℭ (cat_Set α)⦇Obj⦈"
unfolding cat_op_simps cat_FUNCT_components
by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
subsubsection‹Arrow map›
mk_VLambda Yoneda_functor_components(2)
|vsv Yoneda_functor_ArrMap_vsv[cat_cs_intros]|
|vdomain Yoneda_functor_ArrMap_vdomain[cat_cs_simps]|
|app Yoneda_functor_ArrMap_app[cat_cs_simps]|
lemma (in category) Yoneda_functor_ArrMap_vrange:
"ℛ⇩∘ (Yoneda_functor α ℭ⦇ArrMap⦈) ⊆⇩∘ cat_FUNCT α ℭ (cat_Set α)⦇Arr⦈"
proof
(
unfold Yoneda_functor_components,
rule vrange_VLambda_vsubset,
unfold cat_op_simps
)
fix f assume "f ∈⇩∘ ℭ⦇Arr⦈"
then obtain a b where f: "f : a ↦⇘ℭ⇙ b" by auto
define β where "β = α + ω"
have 𝒵β: "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: 𝒵_α_αω 𝒵.intro 𝒵_Limit_αω 𝒵_ω_αω β_def)
from tiny_category_cat_FUNCT category_axioms 𝒵β αβ f show
"ntcf_arrow Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-) ∈⇩∘ cat_FUNCT α ℭ (cat_Set α)⦇Arr⦈"
unfolding cat_op_simps
by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
subsubsection‹The Yoneda Functor is a fully faithful functor›
lemma (in category) cat_Yoneda_functor_is_functor:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "Yoneda_functor α ℭ : op_cat ℭ ↦↦⇩C⇩.⇩f⇩f⇘β⇙ cat_FUNCT α ℭ (cat_Set α)"
proof
(
intro
is_ff_functorI
is_ft_functorI'
is_fl_functorI'
vsubset_antisym
vsubsetI,
unfold cat_op_simps in_Hom_iff,
tactic‹distinct_subgoals_tac›
)
interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
let ?Yf = ‹Yoneda_functor α ℭ› and ?FUNCT = ‹cat_FUNCT α ℭ (cat_Set α)›
show Yf: "?Yf : op_cat ℭ ↦↦⇩C⇘β⇙ ?FUNCT"
proof(intro is_functorI')
show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
from assms have "category β ℭ" by (intro cat_category_if_ge_Limit)
then show "category β (op_cat ℭ)" by (intro category.category_op)
from assms show "category β ?FUNCT"
by
(
cs_concl cs_shallow
cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT
)
show "vcard ?Yf = 4⇩ℕ"
unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (?Yf⦇ObjMap⦈) ⊆⇩∘ ?FUNCT⦇Obj⦈"
by (rule Yoneda_functor_ObjMap_vrange)
show
"?Yf⦇ArrMap⦈⦇f⦈ : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘op_cat ℭ⇙ b" for a b f
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show "?Yf⦇ArrMap⦈⦇g ∘⇩A⇘op_cat ℭ⇙ f⦈ =
?Yf⦇ArrMap⦈⦇g⦈ ∘⇩A⇘?FUNCT⇙ ?Yf⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘op_cat ℭ⇙ c" and "f : a ↦⇘op_cat ℭ⇙ b" for b c g a f
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show "?Yf⦇ArrMap⦈⦇op_cat ℭ⦇CId⦈⦇c⦈⦈ = ?FUNCT⦇CId⦈⦇?Yf⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ op_cat ℭ⦇Obj⦈" for c
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (auto simp: assms(1) Yoneda_functor_components 𝒵.intro 𝒵_Limit_αω 𝒵_ω_αω)
interpret Yf: is_functor β ‹op_cat ℭ› ‹?FUNCT› ‹?Yf› by (rule Yf)
show "v11 (?Yf⦇ArrMap⦈ ↾⇧l⇩∘ Hom ℭ b a)"
if "a ∈⇩∘ ℭ⦇Obj⦈" and "b ∈⇩∘ ℭ⦇Obj⦈" for a b
proof-
from that have dom_Y_ba: "𝒟⇩∘ (?Yf⦇ArrMap⦈ ↾⇧l⇩∘ Hom ℭ b a) = Hom ℭ b a"
by
(
fastforce simp:
cat_op_simps
in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
)
show "v11 (?Yf⦇ArrMap⦈ ↾⇧l⇩∘ Hom ℭ b a)"
proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
fix g f assume prems:
"g : b ↦⇘ℭ⇙ a"
"f : b ↦⇘ℭ⇙ a"
"(?Yf⦇ArrMap⦈ ↾⇧l⇩∘ Hom ℭ b a)⦇g⦈ = (?Yf⦇ArrMap⦈ ↾⇧l⇩∘ Hom ℭ b a)⦇f⦈"
from
prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of α ℭ]
have "Hom⇩A⇩.⇩C⇘α⇙ℭ(g,-) = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
by
(
cs_prems cs_shallow
cs_simp: V_cs_simps cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros
)
from this prems(1,2) show "g = f" by (rule cat_ntcf_Hom_snd_inj)
qed (auto simp: Yoneda_functor_components)
qed
fix a b assume prems: "a ∈⇩∘ ℭ⦇Obj⦈" "b ∈⇩∘ ℭ⦇Obj⦈"
show "𝔑 : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈"
if "𝔑 ∈⇩∘ ?Yf⦇ArrMap⦈ `⇩∘ Hom ℭ b a" for 𝔑
proof-
from that obtain f where "?Yf⦇ArrMap⦈⦇f⦈ = 𝔑" and f: "f : b ↦⇘ℭ⇙ a"
by (force elim!: Yf.ArrMap.vsv_vimageE)
then have 𝔑_def: "𝔑 = ntcf_arrow Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
unfolding
Yoneda_functor_ArrMap_app[
unfolded cat_op_simps, OF cat_is_arrD(1)[OF f]
]
by (simp add: cat_cs_simps cat_op_simps cat_cs_intros)
from category_axioms f show ?thesis
unfolding 𝔑_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
)
qed
show "𝔑 ∈⇩∘ ?Yf⦇ArrMap⦈ `⇩∘ Hom ℭ b a"
if "𝔑 : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈" for 𝔑
proof-
note 𝔑 = cat_FUNCT_is_arrD[OF that]
from 𝔑(1) category_axioms prems have ntcf_𝔑:
"ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔑 :
Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(b,-) : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (subst (asm) 𝔑(3), use nothing in ‹subst (asm) 𝔑(4)›)
(
cs_prems cs_shallow
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
)
from cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF prems ntcf_𝔑] obtain f
where f: "f : b ↦⇘ℭ⇙ a"
and 𝔑_def: "ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔑 = Hom⇩A⇩.⇩C⇘α⇙ℭ(f,-)"
by auto
from 𝔑(2) f show "𝔑 ∈⇩∘ Yoneda_functor α ℭ⦇ArrMap⦈ `⇩∘ Hom ℭ b a"
unfolding 𝔑_def
by (intro Yf.ArrMap.vsv_vimage_eqI[of f])
(
cs_concl cs_shallow
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)+
qed
qed
text‹\newpage›
end